Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

timage.bi

Uploader:MitgliedThePuppetMaster
Datum/Zeit:24.12.2023 01:06:43
Hinweis: Dieser Quelltext ist Bestandteil des Projekts LOUPEDECK-Live Linux Treiber, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

'##############################################################################################################################################################
'##############################################################################################################################################################
'### TImage - V:1.01.0 - R:0
'##############################################################################################################################################################
'##############################################################################################################################################################
'### Date of Idea:  2013.02.22 - 23:46:16
'### Autor:         DeltaLab's Germany [Experimental Computing]
'###                Martin Wiemann
'### Contact:       freeBASIC@DeltaLabs.de   /   IRC://DeltaLabs/#deltalabs
'### Licence:       DE: Tu was du nicht lassen kannst, solange du hiermit nicht mehr Geld verdienst als ich.
'##############################################################################################################################################################
'##############################################################################################################################################################



'##############################################################################################################################################################
#IF Defined(TImage_FreeImage)
    #Include Once "FreeImage.bi"
#ENDIF
#Include Once "crt/string.bi"
#Include Once "fbgfx.bi"



'##############################################################################################################################################################
Enum TImage_LineStyle_Enum
    LineStyle_Continues                 = 0
    LineStyle_Dot
    LineStyle_Dash
    LineStyle_DotDash
    LineStyle_Step2
    LineStyle_Max
End Enum



'##############################################################################################################################################################
Enum TImage_FontType_Enum
    FontType_Monospace                  = 0
    FontType_Dynamicspace
End Enum



'##############################################################################################################################################################
Type TImage
    V_Width                             as UInteger
    V_Height                            as UInteger
    V_BPP                               as UInteger
    V_Data                              as ULong Ptr

    V_FontType                          as TImage_FontType_Enum
    V_FontT                             as UInteger
    V_FontH                             as UInteger
    V_FontP                             as UInteger Ptr
    V_FontW                             as UInteger Ptr

    Declare Sub         CLS             (ByRef V_Color as UInteger = &H00000000)
    Declare Sub         ReplaceColor    (ByRef V_ColorFind as UInteger, ByRef V_ColorReplace as UInteger)
    Declare Sub         PSET            (ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &H00000000)
    Declare Function    Point           (ByRef V_X as Integer, ByRef V_Y as Integer) as UInteger
    Declare Sub         Line            (ByRef V_X1 as Integer, ByRef V_Y1 as Integer, ByRef V_X2 as Integer, ByRef V_Y2 as Integer, ByRef V_Color as UInteger = &H00000000, ByRef V_Box as Integer = 0, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
    Declare Sub         Circle          (ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Radius as Integer, ByRef V_Color as UInteger = &HFFFFFFFF, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
    Declare Sub         Put             (ByRef V_TargetX as Integer, V_TargetY as Integer, ByRef V_SourceImage as TImage Ptr, ByRef V_SourceX as UInteger = 0, ByRef V_SourceY as UInteger = 0, ByRef V_SourceW as UInteger = 0, ByRef V_SourceH as UInteger = 0, ByRef V_CopyMaskColor as UInteger = &HFF000000, ByRef V_PutColor as UInteger = &HFF000000, V_IgnorCopyMaskColor as Integer = 0, V_TransparencyMaskColor as UInteger = &HFF000000)
    Declare Sub         DrawString      (ByRef V_Font as TImage Ptr = 0, ByRef V_Text as String, ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &HFFFFFF, ByRef V_CharSpace as Integer = 0, ByRef V_LineSpace as Integer = 0, ByRef V_NoLinebreak as Integer = 0, ByRef V_CheckAlpha as Integer = 0)
End Type



'##############################################################################################################################################################
Dim Shared TImage_GFX_MainFont as TImage Ptr



'##############################################################################################################################################################
Function TImageCreate(ByRef V_Width as UInteger, ByRef V_Height as UInteger, ByRef V_BPP as UInteger = 32, V_AllocMem as Any Ptr = 0) as TImage Ptr
If (V_Width <= 0) Or (V_Height <= 0) Or (Fix(V_BPP / 8)) <= 0 Then Return 0
Dim TImg as TImage
With TImg
    .V_Width    = V_Width
    .V_Height   = V_Height
    .V_BPP      = V_BPP
    If V_AllocMem = 0 Then
        .V_Data = CAllocate(V_Width * V_Height * Fix(V_BPP / 8))
    Else: .V_Data = V_AllocMem
    End If
End With
Dim TImgPtr as TImage Ptr = New TImage
*TImgPtr = TImg
Return TImgPtr
End Function



'##############################################################################################################################################################
Sub TImageDestroy(ByRef V_Image as TImage Ptr)
If V_Image = 0 Then Exit Sub
If V_Image->V_Data <> 0 Then DeAllocate(V_Image->V_Data)
If V_Image->V_FontP <> 0 Then DeAllocate(V_Image->V_FontP)
If V_Image->V_FontW <> 0 Then DeAllocate(V_Image->V_FontW)
Delete V_Image
V_Image = 0
End Sub



'##############################################################################################################################################################
Function TCheckDiffed(ByRef V_Image1 as TImage Ptr, ByRef V_Image2 as TImage Ptr) as Integer
If V_Image1 = 0 Then Return 1
If V_Image2 = 0 Then Return 1
If V_Image1->V_Width <> V_Image2->V_Width Then Return 1
If V_Image1->V_Height <> V_Image2->V_Height Then Return 1
If V_Image1->V_BPP <> V_Image2->V_BPP Then Return 1
If V_Image1->V_Width = 0 Then Return 0
If V_Image2->V_Height = 0 Then Return 0

'Dim TData1 as Any Ptr = V_Image1->V_Data
'Dim TData2 as Any Ptr = V_Image2->V_Data
'Dim TMax as UInteger = V_Image1->V_Width * V_Image1->V_Height * Fix(V_Image1->V_BPP / 8)
''Print #1, "TMax0:" & TMax
'For X as UInteger = 0 to TMax - 1
'   'If V_Image1->V_Data[X] <> V_Image2->V_Data[X] Then Return 1
'   If Cast(UByte Ptr, TData1)[X] <> Cast(UByte Ptr, TData2)[X] Then Return 1
'Next

Dim TAdr as UInteger
For Y as UInteger = 0 to V_Image1->V_Height - 1
    For X as UInteger = 0 to V_Image1->V_Width - 1
        TAdr = Y * V_Image1->V_Width + X
        If V_Image1->V_Data[TAdr] <> V_Image2->V_Data[TAdr] Then Return 1
    Next
Next
Return 0
End Function



'##############################################################################################################################################################
Function TDataCopy(ByRef V_Source as TImage Ptr, ByRef V_Dest as TImage Ptr) as Integer
If V_Source = 0 Then Return 0
If V_Dest = 0 Then Return 0
If V_Source->V_Width <> V_Dest->V_Width Then Return 0
If V_Source->V_Height <> V_Dest->V_Height Then Return 0
If V_Source->V_BPP <> V_Dest->V_BPP Then Return 0
If V_Source->V_Width = 0 Then Return 0
If V_Dest->V_Height = 0 Then Return 0
'Dim TMax as UInteger = V_Source->V_Width * V_Source->V_Height
'Print #1, "TMax1:" & TMax
'For X as UInteger = 0 to TMax
'   V_Dest->V_Data[X] = V_Source->V_Data[X]
'Next
Dim TAdr as UInteger
For Y as UInteger = 0 to V_Source->V_Height - 1
    For X as UInteger = 0 to V_Source->V_Width - 1
        TAdr = Y * V_Source->V_Width + X
        V_Dest->V_Data[TAdr] = V_Source->V_Data[TAdr]
    Next
Next
Return 1
End Function



'##############################################################################################################################################################
Function TLoadImageFromFile(ByRef V_FilePathName as String, ByRef R_TransparencyColor as UInteger = &HFF000000, ByRef R_Width as UInteger = 0, ByRef R_Height as UInteger = 0, ByRef R_FileMutex as Any Ptr = 0) as TImage Ptr
Dim TImg As TImage Ptr
#IF Defined(TFreeImage)
    Dim FIF As FREE_IMAGE_FORMAT
    Dim dib As FIBITMAP Ptr
    Dim dib32 As FIBITMAP Ptr
    Dim DIBWidth As UInteger
    Dim DIBHeight As UInteger
    Dim flags As UInteger
    Dim Bits As Any Ptr
    FIF = FreeImage_GetFileType(StrPtr(V_FilePathName), 0)
    If FIF = FIF_UNKNOWN Then FIF = FreeImage_GetFIFFromFilename(StrPtr(V_FilePathName))
    If FIF = FIF_UNKNOWN Then Return NULL
    If FIF = FIF_JPEG Then flags = JPEG_ACCURATE
    dib = FreeImage_Load(FIF, StrPtr(V_FilePathName), flags)
    If dib = 0 Then Return NULL
    DIBWidth = FreeImage_GetWidth(dib)
    DIBHeight = FreeImage_GetHeight(dib)
    TImg = TImageCreate(DIBWidth, DIBHeight, 32)
    If TImg = 0 Then FreeImage_Unload dib: Return 0
    FreeImage_FlipVertical Dib
    Dib32 = FreeImage_ConvertTo32Bits(Dib)
    Bits = FreeImage_GetBits(Dib32)
    #IF defined(__fb_win32__)
        movememory Cast(UByte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    #ELSEIF defined(__fb_linux__)
        memcpy Cast(UByte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    #ENDIF
    R_Width = DIBWidth
    R_Height = DIBHeight
    FreeImage_Unload dib
    FreeImage_Unload dib32
#ELSE
    If R_FileMutex <> 0 Then MutexLock(R_FileMutex)
    If Dir(V_FilePathName, -1) = "" Then
        If R_FileMutex <> 0 Then MutexUnLock(R_FileMutex)
        Return 0
    End If
    Dim TFNID as Integer = FreeFile()
    If Open(V_FilePathName For Binary Access Read As #TFNID)    <> 0 Then Return 0
    If R_FileMutex <> 0 Then MutexUnLock(R_FileMutex)
    Dim TSig            as UShort   :   If Get(#TFNID, , TSig)      <> 0 Then Close #TFNID: Return 0
    Dim TSize           as ULong    :   If Get(#TFNID, , TSize)     <> 0 Then Close #TFNID: Return 0
    Dim TRes1           as UShort   :   If Get(#TFNID, , TRes1)     <> 0 Then Close #TFNID: Return 0
    Dim TRes2           as UShort   :   If Get(#TFNID, , TRes2)     <> 0 Then Close #TFNID: Return 0
    Dim TOffset         as ULong    :   If Get(#TFNID, , TOffset)   <> 0 Then Close #TFNID: Return 0
    If TSig         <> &H4D42 Then Close #TFNID: Return 0
    If TSize         < 1 Then Close #TFNID: Return 0
    Dim TDIBSize        as ULong    :   If Get(#TFNID, , TDIBSize)  <> 0 Then Close #TFNID: Return 0
    Dim TWidth          as Long     :   If Get(#TFNID, , TWidth)    <> 0 Then Close #TFNID: Return 0
    Dim THeight         as Long     :   If Get(#TFNID, , THeight)   <> 0 Then Close #TFNID: Return 0
    Dim TPlanes         as UShort   :   If Get(#TFNID, , TPlanes)   <> 0 Then Close #TFNID: Return 0
    Dim TBPP            as UShort   :   If Get(#TFNID, , TBPP)      <> 0 Then Close #TFNID: Return 0
    Dim TCompress       as ULong    :   If Get(#TFNID, , TCompress) <> 0 Then Close #TFNID: Return 0
    Dim TImgSize        as ULong    :   If Get(#TFNID, , TImgSize)  <> 0 Then Close #TFNID: Return 0
    Dim TXPPM           as ULong    :   If Get(#TFNID, , TXPPM)     <> 0 Then Close #TFNID: Return 0
    Dim TYPPM           as ULong    :   If Get(#TFNID, , TYPPM)     <> 0 Then Close #TFNID: Return 0
    Dim TCCT            as ULong    :   If Get(#TFNID, , TCCT)      <> 0 Then Close #TFNID: Return 0
    Dim TICC            as ULong    :   If Get(#TFNID, , TICC)      <> 0 Then Close #TFNID: Return 0
    Dim TMask(0 to 3)   as ULong
    If Get(#TFNID, , TMask(0)) <> 0 Then Close #TFNID: Return 0
    If Get(#TFNID, , TMask(1)) <> 0 Then Close #TFNID: Return 0
    If Get(#TFNID, , TMask(2)) <> 0 Then Close #TFNID: Return 0
    If Get(#TFNID, , TMask(3)) <> 0 Then Close #TFNID: Return 0
    If TWidth        < 1 Then Close #TFNID: Return 0
    If THeight       < 1 Then Close #TFNID: Return 0
    If TPlanes      <> 1 Then Close #TFNID: Return 0
    If TBPP          < 1 Then Close #TFNID: Return 0
    If TCompress    <> 0 Then Close #TFNID: Return 0
    Dim T as String
    Dim X as Integer
    Dim Y as Integer
    Seek #TFNID, TOffset + 1
    Select Case TBPP
        Case 24
            Y = TWidth * (TBPP / 8)
            If (Y Mod 4) <> 0 Then Y = Fix(TWidth * (TBPP / 8) / 4) * 4 + 4
            T = Space(Y)
            TImg = TImageCreate(CInt(TWidth), CInt(THeight))
            For Y = THeight - 1 To 0 Step -1
                Get #TFNID, , T
                For X = 0 To TWidth * (TBPP / 8) - 1 Step (TBPP / 8)
                    TImg->V_Data[Y * TWidth + (X / (TBPP / 8))] = (T[X + 2] shl 16) or (T[X + 1] shl 8) or T[X]
                Next
            Next
        Case Else: Close #TFNID: Return 0
    End Select
    Close #TFNID
#ENDIF
Return TImg
End Function



'###############################################################################################################################################
Function TLoadImageFromMem(ByRef V_Data as String, ByRef R_TransparencyColor as UInteger = &HFF000000, ByRef R_Width as UInteger = 0, ByRef R_Height as UInteger = 0) as TImage Ptr
Dim TImg as TImage Ptr
#IF Defined(TFreeImage)
    If Len(V_Data) <= 0 Then Return 0
    Dim MEM as FIMEMORY Ptr
    MEM = FreeImage_OpenMemory(Cast(Byte Ptr, @V_Data[0]), Len(V_Data))
    If MEM = 0 Then Return 0
    Dim DIB As FIBITMAP Ptr
    DIB = FreeImage_LoadFromMemory(FIF_JPEG, MEM, JPEG_DEFAULT)
    If DIB = 0 Then FreeImage_CloseMemory(MEM): Return 0
    Dim DIBWidth as Integer = Cast(Integer, FreeImage_GetWidth(DIB))
    Dim DIBHeight as Integer = Cast(Integer, FreeImage_GetHeight(DIB))
    If (DIBWidth <= 0) or (DIBHeight <= 0) Then FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    FreeImage_FlipVertical(DIB)
    Dim DIB32 as FIBITMAP Ptr = FreeImage_ConvertTo32Bits(DIB)
    If DIB32 = 0 Then FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    TImg = TImageCreate(DIBWidth, DIBHeight, 32)
    If TImg = 0 Then FreeImage_Unload(DIB32): FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    Dim Bits as Any Ptr = FreeImage_GetBits(DIB32)
    #IF defined(__fb_win32__)
        movememory Cast(UByte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    #ELSEIF defined(__fb_linux__)
        memcpy Cast(UByte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    #ENDIF
    R_Width = DIBWidth
    R_Height = DIBHeight
    FreeImage_Unload(DIB32)
    FreeImage_Unload(DIB)
    FreeImage_CloseMemory(MEM)
#ELSE

#ENDIF
Return TImg
End Function



'##############################################################################################################################################################
Function TImageScale(ByRef V_Image as TImage Ptr, V_Width as UInteger, V_Height as UInteger, V_ScaleType as Integer = 1) as TImage Ptr
If V_Image = 0 Then Return 0
If V_Width <= 0 Then Return 0
If V_Height <= 0 Then Return 0
Dim TImg as TImage Ptr = TImageCreate(V_Width, V_Height, V_Image->V_BPP)
Dim TW as UInteger = V_Image->V_Width
Dim TH as UInteger = V_Image->V_Height
If V_Width > V_Image->V_Width Then TW = V_Width
If V_Height > V_Image->V_Height Then TH = V_Height
Dim TSourceW as UInteger = V_Image->V_Width * V_Image->V_Height
Dim TTargetW as UInteger = TImg->V_Width * TImg->V_Height
Dim TSourceDW as Single = V_Image->V_Width / TW
Dim TSourceDH as Single = V_Image->V_Height / TH
Dim TTargetDW as Single = TImg->V_Width / TW
Dim TTargetDH as Single = TImg->V_Height / TH
Dim TSourceL as UInteger
Dim TTargetL as UInteger
Dim TSourceP as Integer
Dim TTargetP as Integer
Dim X as Integer
Dim Y as Integer

Select Case V_ScaleType
    Case 0 'BilineareInterpolation
        For Y = 0 to TH - 1
            For X = 0 to TW - 1
                TSourceP = CInt(Fix(TSourceDH * Y) * V_Image->V_Width + Fix(TSourceDW * X))
                TTargetP = CInt(Fix(TTargetDH * Y) * TImg->V_Width + Fix(TTargetDW * X))
                TImg->V_Data[TTargetP] = V_Image->V_Data[TSourceP]
            Next
        Next

    Case Else 'NearestNeighbor
        For Y = 0 to TH - 1
            TSourceL = Fix(TSourceDH * Y) * V_Image->V_Width
            TTargetL = Fix(TTargetDH * Y) * TImg->V_Width
            For X = 0 to TW - 1
                TSourceP = CInt(TSourceL + Fix(TSourceDW * X))
                TTargetP = CInt(TTargetL + Fix(TTargetDW * X))
                TImg->V_Data[TTargetP] = V_Image->V_Data[TSourceP]
            Next
        Next

End Select
Return TImg
End Function



'##############################################################################################################################################################
Function TLoadFontDynamicspaceFromFile(ByRef V_FilePathName as String, ByRef R_TransparencyColor as UInteger = &HFF000000, ByRef V_ScaleFactor as Double = 1.0, ByRef R_FileMutex as Any Ptr = 0) as TImage Ptr
Dim TImgT as TImage Ptr = TLoadImageFromFile(V_FilePathName, R_TransparencyColor, , , R_FileMutex)
If TImgT = 0 Then Return 0
Dim TImg as TImage Ptr = TImgT
If V_ScaleFactor <> 1.0 Then
    TImg = TImageScale(TImgT, TImgT->V_Width * V_ScaleFactor, TImgT->V_Height * V_ScaleFactor)
    TImageDestroy(TImgT)
End If
If TImg = 0 Then Return 0
With *TImg
    Dim M as Integer
    Dim Z as Integer
    Dim TF as Integer
    Dim TFC as Integer = ASC("A")
    .V_FontType = FontType_Dynamicspace
    .V_FontP = CAllocate(SizeOf(UInteger) * 255)
    .V_FontW = CAllocate(SizeOf(UInteger) * 255)

    TF = 0
    For Y as Integer = 0 to .V_Height - 1
        For X as Integer = 0 to .V_Width - 1
            If .V_Data[Y * .V_Width + X] <> &H00000000 Then
                .V_FontT = Y
                TF = 1
                Exit For
            End If
        Next
        If TF = 1 Then Exit For
    Next
    TF = 0
    For Y as Integer = .V_Height - 1 to 0 Step -1
        For X as Integer = 0 to .V_Width - 1
            If .V_Data[Y * .V_Width + X] <> &H00000000 Then
                .V_FontH = Y - .V_FontT + 1
                TF = 1
                Exit For
            End If
        Next
        If TF = 1 Then Exit For
    Next

    For X as Integer = 0 to .V_Width - 1
        TF = 0
        For Y as Integer = 0 to .V_Height - 1
            If M = 0 Then
                TF = 1
                If .V_Data[Y * .V_Width + X] <> &H00000000 Then
                    .V_FontP[TFC] = X
                    M = 1
                    Exit For
                End If
            Else
                If .V_Data[Y * .V_Width + X] = &H00FF0000 Then .V_Data[Y * .V_Width + X] = R_TransparencyColor
                If .V_Data[Y * .V_Width + X] <> &H00000000 Then TF = 1: Exit For
            End If
        Next
        If TF = 0 Then
            .V_FontW[TFC] = X - .V_FontP[TFC]
            M = 0
            Z += 1
            Select Case Z
                Case 0 to 25: TFC = 65 + Z 'AZ
                Case 26: TFC = 153
                Case 27: TFC = 142
                Case 28: TFC = 154
                Case 29 to 54: TFC = 97 + (Z - 29) 'az
                Case 55 : TFC = 148
                Case 56: TFC = 132
                Case 57: TFC = 129
                Case 58: TFC = 225
                Case 59 to 68: TFC = 48 + (Z - 59) '09
                Case 69: TFC = 230
                Case 70: TFC = ASC("<")
                Case 71: TFC = ASC("|")
                Case 72: TFC = ASC(">")
                Case 73: TFC = ASC(",")
                Case 74: TFC = ASC(".")
                Case 75: TFC = ASC("-")
                Case 76: TFC = ASC(";")
                Case 77: TFC = ASC(":")
                Case 78: TFC = ASC("_")
                Case 79: TFC = ASC("#")
                Case 80: TFC = ASC("+")
                Case 81: TFC = ASC("*")
                Case 82: TFC = 248
                Case 83: TFC = ASC("!")
                Case 84: TFC = ASC("""")
                Case 85: TFC = 167
                Case 86: TFC = ASC("$")
                Case 87: TFC = ASC("%")
                Case 88: TFC = ASC("&")
                Case 89: TFC = ASC("/")
                Case 90: TFC = ASC("(")
                Case 91: TFC = ASC(")")
                Case 92: TFC = ASC("=")
                Case 93: TFC = ASC("?")
                Case 94: TFC = ASC("{")
                Case 95: TFC = ASC("[")
                Case 96: TFC = ASC("]")
                Case 97: TFC = ASC("}")
                Case 98: TFC = ASC("\")
                Case 99: TFC = ASC("@")
                Case 100: TFC = 128 '€
                Case Else: TFC = 0
            End Select
            'If TFC > 0 Then Print "CHR: >" & Z & "<___>" & TFC & "<___>" & Chr(TFC) & "<"
        End If
    Next
End With
Return TImg
End Function



'##############################################################################################################################################################
Sub TCLS(ByRef V_Image as TImage Ptr, ByRef V_Color as UInteger = &H00000000)
If V_Image = 0 Then Exit Sub
With *V_Image
    Dim TW as UInteger = .V_Width * 4
    Dim TMem as ULong Ptr = Allocate(TW)
    For X as UInteger = 0 to .V_Width - 1
        TMem[X] = V_Color
    Next
    For X as UInteger = 0 to .V_Height - 1
        memcpy(@.V_Data[X * .V_Width], TMem, TW)
    Next
    DeAllocate(TMem)
End With
End Sub



'##############################################################################################################################################################
Sub TReplaceColor(ByRef V_Image as TImage Ptr, ByRef V_ColorFind as UInteger, ByRef V_ColorReplace as UInteger)
If V_Image = 0 Then Exit Sub
With *V_Image
    For X as UInteger = 0 to .V_Height * .V_Width - 1
        If .V_Data[X] = V_ColorFind Then .V_Data[X] = V_ColorReplace
    Next
End With
End Sub



'##############################################################################################################################################################
#Macro TPSet(V_Image, V_X, V_Y, V_Color)
If V_Image <> 0 Then
    With *V_Image
        If (V_X >= 0) AndAlso (V_X < .V_Width) AndAlso (V_Y >= 0) AndAlso (V_Y < .V_Height) Then .V_Data[V_Y * .V_Width + V_X] = V_Color
    End With
End If
#EndMacro



'##############################################################################################################################################################
Function TPoint(ByRef V_Image as TImage Ptr, ByRef V_X as Integer, ByRef V_Y as Integer) as UInteger
If V_Image = 0 Then Return 0
With *V_Image
    If (V_X >= 0) AndAlso (V_X < .V_Width) AndAlso (V_Y >= 0) AndAlso (V_Y < .V_Height) Then Return .V_Data[V_Y * .V_Width + V_X]
End With
Return 0
End Function



'##############################################################################################################################################################
#Macro TINT_Point_SetVal(RV_DataPtr, V_Color, V_LineStyle, RV_TC)
Select Case V_LineStyle
    Case LineStyle_Continues
        RV_DataPtr = V_Color

    Case LineStyle_Dot
        If RV_TC = 0 Then
            RV_DataPtr = V_Color
            RV_TC = 1
        Else: RV_TC = 0
        End If

    Case LineStyle_DotDash
        RV_TC += 1
        Select Case RV_TC
            Case 1: RV_DataPtr = V_Color
            Case 2 to 3
            Case 4 to 7: RV_DataPtr = V_Color
            Case 8
            Case Else: RV_TC = 0
        End Select

    Case LineStyle_Dash
        RV_TC += 1
        Select Case RV_TC
            Case 1 to 4: RV_DataPtr = V_Color
            Case 5 to 8
            Case Else: RV_TC = 0
        End Select

    Case LineStyle_Step2
        RV_TC += 1
        Select Case RV_TC
            Case 1 to 2: RV_DataPtr = V_Color
            Case 3 to 4
            Case Else: RV_TC = 0
        End Select

End Select
#EndMacro



'##############################################################################################################################################################
Sub TLine(ByRef V_Image as TImage Ptr, ByRef V_X1 as Integer, ByRef V_Y1 as Integer, ByRef V_X2 as Integer, ByRef V_Y2 as Integer, ByRef V_Color as UInteger = &HFFFFFFFF, ByRef V_Box as Integer = 0, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
If V_Image = 0 Then Exit Sub
If V_Image->V_Data = 0 Then Exit Sub
Dim TX1 as Integer = V_X1
Dim TX2 as Integer = V_X2
Dim TY1 as Integer = V_Y1
Dim TY2 as Integer = V_Y2
Dim TC1 as UInteger
Dim TC2 as UInteger
Dim TD1 as UInteger
Dim TD2 as UInteger
Dim TW1 as UInteger
Dim TMDLen as UInteger = V_Image->V_Width * V_Image->V_Height
With *V_Image
    If V_Box = 1 Then
        If TX1 < 0 Then TX1 = 0
        If TX1 >= .V_Width Then TX1 = .V_Width - 1
        If TX2 < 0 Then TX2 = 0
        If TX2 >= .V_Width Then TX2 = .V_Width - 1
        If TY1 < 0 Then TY1 = 0
        If TY1 >= .V_Height Then TY1 = .V_Height - 1
        If TY2 < 0 Then TY2 = 0
        If TY2 >= .V_Height Then TY2 = .V_Height - 1
        If TX1 > TX2 Then Swap TX1, TX2
        If TY1 > TY2 Then Swap TY1, TY2
        If V_Filled = 1 Then
            If V_LineStyle <> LineStyle_Continues Then
                For Y as Integer = TY1 to TY2
                    If TC2 = 0 Then TC2 = 1 Else TC2 = 0
                    TC1 = TC2
                    For X as Integer = TX1 to TX2
                        TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + X], V_Color, V_LineStyle, TC1)
                    Next
                Next
            Else
                For Y as Integer = TY1 to TY2
                    For X as Integer = TX1 to TX2
                        V_Image->V_Data[Y * .V_Width + X] = V_Color
                    Next
                Next
            End If
        Else
            For X as Integer = TX1 to TX2
                TINT_Point_SetVal(V_Image->V_Data[TY1 * .V_Width + X], V_Color, V_LineStyle, TC1)
                TINT_Point_SetVal(V_Image->V_Data[TY2 * .V_Width + X], V_Color, V_LineStyle, TC2)
            Next
            For Y as Integer = TY1 to TY2
                TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX1], V_Color, V_LineStyle, TC1)
                TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX2], V_Color, V_LineStyle, TC2)
            Next
        End If
    Else
        If TX1 = TX2 Then
            If TX1 < 0 Then TX1 = 0
            If TX1 >= .V_Width Then TX1 = .V_Width - 1
            If TX2 < 0 Then TX2 = 0
            If TX2 >= .V_Width Then TX2 = .V_Width - 1
            If TY1 < 0 Then TY1 = 0
            If TY1 >= .V_Height Then TY1 = .V_Height - 1
            If TY2 < 0 Then TY2 = 0
            If TY2 >= .V_Height Then TY2 = .V_Height - 1
            If TX1 > TX2 Then Swap TX1, TX2
            If TY1 > TY2 Then Swap TY1, TY2
            For Y as Integer = TY1 to TY2
                TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX1], V_Color, V_LineStyle, TC1)
            Next
        ElseIf TY1 = TY2 Then
            If TX1 < 0 Then TX1 = 0
            If TX1 >= .V_Width Then TX1 = .V_Width - 1
            If TX2 < 0 Then TX2 = 0
            If TX2 >= .V_Width Then TX2 = .V_Width - 1
            If TY1 < 0 Then TY1 = 0
            If TY1 >= .V_Height Then TY1 = .V_Height - 1
            If TY2 < 0 Then TY2 = 0
            If TY2 >= .V_Height Then TY2 = .V_Height - 1
            If TX1 > TX2 Then Swap TX1, TX2
            If TY1 > TY2 Then Swap TY1, TY2
            For X as Integer = TX1 to TX2
                TINT_Point_SetVal(V_Image->V_Data[TY1 * .V_Width + X], V_Color, V_LineStyle, TC1)
            Next
        Else
            Dim TMultiplier as Double
            If Abs(TX2 - TX1) > Abs(TY2 - TY1) Then
                TMultiplier = (TY2 - TY1) / (TX2 - TX1)
                For X as Integer = IIf(TX1 < TX2, TX1, TX2) to IIf(TX1 < TX2, TX2, TX1)
                    If X >= .V_Width Then Exit For
                    If X >= 0 Then
                        TD1 = (CInt(TY1 + (X - TX1) * TMultiplier) * .V_Width + X)
                        If TMDLen > TD1 Then
                            TINT_Point_SetVal(V_Image->V_Data[TD1], V_Color, V_LineStyle, TC1)
                        End If
                    End If
                Next
            Else
                TMultiplier = (TX2 - TX1) / (TY2 - TY1)
                TW1 = (.V_Width - 1)
                For Y as Integer = IIf(TY1 < TY2, TY1, TY2) to IIf(TY1 < TY2, TY2, TY1)
                    If Y >= .V_Height Then Exit For
                    If Y >= 0 Then
                        TD1 = (TX1 + (Y - TY1) * TMultiplier)
                        TD2 = CInt(Y * .V_Width) + TD1
                        If TMDLen > TD2 Then
                            If (TD1 >= 0) and (TD1 < TW1) Then
                                TINT_Point_SetVal(V_Image->V_Data[TD2], V_Color, V_LineStyle, TC1)
                            End If
                        End If
                    End If
                Next
            End If
        End If
    End If
End With
End Sub



'##############################################################################################################################################################
Sub TCircle(ByRef V_Image as TImage Ptr, ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Radius as Integer, ByRef V_Color as UInteger = &HFFFFFFFF, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
If V_Image = 0 Then Exit Sub
If V_Image->V_Data = 0 Then Exit Sub
Dim TMDLen as UInteger = V_Image->V_Width * V_Image->V_Height
With *V_Image
    Dim D as Double = -V_Radius
    Dim Y as Double
    Dim X as Double = V_Radius
    Dim TW1 as UInteger
    Dim TC1(8) as UInteger
    Dim TV as Integer
    If V_Filled = 0 Then
        Do Until Y > X
            TW1 = (V_X + X)
            If (TW1 >= 0) and (TW1 < .V_Width) Then
                TV = (TW1 + (V_Y + Y) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                End If
                TV = (TW1 + (V_Y + V_Radius - Y - V_Radius) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(2))
                End If
            End If
            TW1 = (V_X + V_Radius - X - V_Radius)
            If (TW1 >= 0) and (TW1 < .V_Width) Then
                TV = (TW1 + (V_Y + Y) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(3))
                End If
                TV = TW1 + (V_Y + V_Radius - Y - V_Radius) * .V_Width
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(4))
                End If
            End If
            TW1 = (V_X + Y)
            If (TW1 >= 0) and (TW1 < .V_Width) Then
                TV = TW1 + (V_Y + X) * .V_Width
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(5))
                End If
                TV = (TW1 + (V_Y + V_Radius - X - V_Radius) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(6))
                End If
            End If
            TW1 = (V_X + V_Radius - Y - V_Radius)
            If (TW1 >= 0) and (TW1 < .V_Width) Then
                TV = (TW1 + (V_Y + X) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(7))
                End If
                TV = (TW1 + (V_Y + V_Radius - X - V_Radius) * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(8))
                End If
            End If
            D = D + 2 * Y + 1
            Y = Y + 1
            If D > 0 Then
                D = D - 2 * X + 2
                X = X - 1
            End If
        Loop
    Else
        Dim TY as Integer
        Dim TYL1 as Double
        Dim TYL2 as Double
        Dim TX1a as Double
        Dim TX1b as Double
        Dim TX2a as Double
        Dim TX2b as Double
        Dim T1i as Integer
        Dim T2i as Integer
        Dim TModX as Integer
        Select Case V_LineStyle
            Case LineStyle_Continues    : TModX = 1
            Case LineStyle_Dot          : TModX = 2
            Case LineStyle_DotDash      : TModX = 8
            Case LineStyle_Dash         : TModX = 4
            Case LineStyle_Step2        : TModX = 2
        End Select
        Do Until Y > X
            TY = V_Y + Y
            If (TY >= 0) and (TY < .V_Height) Then
                TC1(1) = (TY + V_X + V_Radius - X - V_Radius) mod TModX
                For XX as Integer = V_X + V_Radius - X - V_Radius to V_X + X
                    If (XX >= 0) and (XX < .V_Width) Then
                        TV = Int(XX + TY * .V_Width)
                        If (TV >= 0) and (TV < TMDLen) Then
                            TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                        End If
                    End If
                Next
                TY = V_Y + V_Radius - Y - V_Radius
                TC1(1) = (TY + V_X + V_Radius - X - V_Radius) mod TModX
                For XX as Integer = V_X + V_Radius - X - V_Radius to V_X + X
                    If (XX >= 0) and (XX < .V_Width) Then
                        TV = Int(XX + TY * .V_Width)
                        If (TV >= 0) and (TV < TMDLen) Then
                            TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                        End If
                    End If
                Next
                TY = V_Y + X
                If TYL1 <> TY Then
                    If T1i = 1 Then
                        TC1(1) = (TY + TX1a - 1) mod TModX
                        For XX as Double = TX1a to TX1b
                            If (XX >= 0) and (XX < .V_Width) Then
                                TV = Int(XX + TYL1 * .V_Width)
                                If (TV >= 0) and (TV < TMDLen) Then
                                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                                End If
                            End If
                        Next
                    End If
                    T1i = 1
                    TYL1 = TY
                End If
                TX1a = V_X + V_Radius - Y - V_Radius
                TX1b = V_X + Y
                TY = V_Y + V_Radius - X - V_Radius
                If TYL2 <> TY Then
                    If T2i = 1 Then
                        TC1(1) = (TY + TX2a - 1) mod TModX
                        For XX as Double = TX2a to TX2b
                            If (XX >= 0) and (XX < .V_Width) Then
                                TV = Int(XX + TYL2 * .V_Width)
                                If (TV >= 0) and (TV < TMDLen) Then
                                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                                End If
                            End If
                        Next
                    End If
                    T2i = 1
                    TYL2 = TY
                End If
                TX2a = V_X + V_Radius - Y - V_Radius
                TX2b = V_X + Y
            End If
            D = D + 2 * Y + 1
            Y = Y + 1
            If D > 0 Then
                D = D - 2 * X + 2
                X = X - 1
            End If
        Loop
        TC1(1) = (TY + TX2a) mod TModX
        For XX as Integer = V_X + V_Radius - Y - V_Radius + 1 to V_X + Y - 1
            If (XX >= 0) and (XX < .V_Width) Then
                TV = Int(XX + TYL1 * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                End If
            End If
        Next
        TC1(1) = (TY + TX1a) mod TModX
        For XX as Integer = V_X + V_Radius - Y - V_Radius + 1 to V_X + Y - 1
            If (XX >= 0) and (XX < .V_Width) Then
                TV = Int(XX + TYL2 * .V_Width)
                If (TV >= 0) and (TV < TMDLen) Then
                    TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
                End If
            End If
        Next
    End If
End With
End Sub



'##############################################################################################################################################################
Function TPut_AlphaBlitterGray(ByRef V_SourcePix as ULong, ByRef V_DestPix as ULong, ByRef V_Param as UInteger) as ULong
If (V_SourcePix and &HFFFFFF) = &HFF00FF Then Return V_DestPix
If (V_SourcePix and &HFFFFFF) = &H000000 Then Return V_DestPix
Dim TA as ULong = V_SourcePix and &H0000FF
Dim TDR as ULong = (V_DestPix and &HFF0000) shr 16
Dim TDG as ULong = (V_DestPix and &H00FF00) shr 8
Dim TDB as ULong = (V_DestPix and &H0000FF)
Dim TPR as ULong = (V_Param and &HFF0000) shr 16
Dim TPG as ULong = (V_Param and &H00FF00) shr 8
Dim TPB as ULong = (V_Param and &H0000FF)
Dim TOut as ULong
If TDR > TPR Then
    TOut = TPR + (TDR - TPR) / 255 * (255 - TA)
Else: TOut = TDR + (TPR - TDR) / 255 * TA
End If
TOut shl= 8
If TDG > TPG Then
    TOut or= TPG + (TDG - TPG) / 255 * (255 - TA)
Else: TOut or= TDG + (TPG - TDG) / 255 * TA
End If
TOut shl= 8
If TDB > TPB Then
    TOut or= TPB + (TDB - TPB) / 255 * (255 - TA)
Else: TOut or= TDB + (TPB - TDB) / 255 * TA
End If
Return &HFF000000 or TOut
End Function



'##############################################################################################################################################################
Sub TPut(ByRef V_TargetImage as TImage Ptr, ByRef V_TargetX as Integer, V_TargetY as Integer, ByRef V_SourceImage as TImage Ptr, ByRef V_SourceX as UInteger = 0, ByRef V_SourceY as UInteger = 0, ByRef V_SourceW as UInteger = 0, ByRef V_SourceH as UInteger = 0, ByRef V_CopyMaskColor as UInteger = &HFF000000, ByRef V_PutColor as UInteger = &HFF000000, V_IgnorCopyMaskColor as Integer = 0, V_TransparencyMaskColor as UInteger = &HFF000000, V_UseGrayScaleAsAlpha as Integer = 0, V_UseAlphaChan as Integer = 0, V_UsePutColor as Integer = 0)
If V_TargetImage = 0 Then Exit Sub
If V_SourceImage = 0 Then Exit Sub
If V_TargetImage->V_Data = 0 Then Exit Sub
If V_SourceImage->V_Data = 0 Then Exit Sub
Dim SX1 as Integer = V_SourceX
Dim SY1 as Integer = V_SourceY
Dim SX2 as Integer = V_SourceX + V_SourceW
Dim SY2 as Integer = V_SourceY + V_SourceH
If (V_SourceX = 0) and (V_SourceY = 0) and (V_SourceW = 0) and (V_SourceH = 0) Then
    SX2 = V_SourceImage->V_Width - 1
    SY2 = V_SourceImage->V_Height - 1
End If
If SX2 >= V_SourceImage->V_Width Then SX2 = V_SourceImage->V_Width - 1
If SY2 >= V_SourceImage->V_Height Then SY2 = V_SourceImage->V_Height - 1
If SX1 >= SX2 Then Exit Sub
If SY1 >= SY2 Then Exit Sub
Dim X as Integer
Dim Y as Integer
Dim TX as Integer
Dim TY as Integer = V_TargetY
If V_IgnorCopyMaskColor = 0 Then
    If V_CopyMaskColor <> &HFF000000 Then
        If V_UseGrayScaleAsAlpha = 0 Then
            For Y = SY1 to SY2
                If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                    TX = V_TargetX
                    For X = SX1 to SX2
                        If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                            If V_CopyMaskColor = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
                                V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_PutColor
                            End If
                        End If
                        TX += 1
                    Next
                End If
                TY += 1
            Next
        Else
            For Y = SY1 to SY2
                If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                    TX = V_TargetX
                    For X = SX1 to SX2
                        If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                            V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = TPut_AlphaBlitterGray(V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X], V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX], V_PutColor)
                        End If
                        TX += 1
                    Next
                End If
                TY += 1
            Next
        End If
    Else
        If V_UsePutColor = 0 Then
            For Y = SY1 to SY2
                If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                    TX = V_TargetX
                    For X = SX1 to SX2
                        If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                            If V_TransparencyMaskColor <> V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
                                V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X]
                            End If
                        End If
                        TX += 1
                    Next
                End If
                TY += 1
            Next
        Else
            For Y = SY1 to SY2
                If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                    TX = V_TargetX
                    For X = SX1 to SX2
                        If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                            If V_TransparencyMaskColor <> V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
                                V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_PutColor
                            End If
                        End If
                        TX += 1
                    Next
                End If
                TY += 1
            Next
        End If
    End If
Else
    If V_UseAlphaChan = 0 Then
        For Y = SY1 to SY2
            If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                TX = V_TargetX
                For X = SX1 to SX2
                    If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                        If V_CopyMaskColor <> V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
                            V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X]
                        End If
                    End If
                    TX += 1
                Next
            End If
            TY += 1
        Next
    Else
        'Print #1, "ALPHA-BLIT:" & Timer()
        Dim TA as UInteger
        Dim TDR as UInteger
        Dim TDG as UInteger
        Dim TDB as UInteger
        Dim TPR as UInteger
        Dim TPG as UInteger
        Dim TPB as UInteger
        Dim TSrc as UInteger
        Dim TDest as UInteger
        Dim TOut as UInteger
        For Y = SY1 to SY2
            If (TY >= 0) and (TY < V_TargetImage->V_Height) Then
                TX = V_TargetX
                For X = SX1 to SX2
                    If (TX >= 0) and (TX < V_TargetImage->V_Width) Then
                        TSrc = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X]
                        TDest = V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX]
                        TA = (TSrc and &HFF000000) shr 24
                        TDR = (TDest and &H00FF0000) shr 16
                        TDG = (TDest and &H0000FF00) shr 8
                        TDB = (TDest and &H000000FF)
                        TPR = (TSrc and &H00FF0000) shr 16
                        TPG = (TSrc and &H0000FF00) shr 8
                        TPB = (TSrc and &H000000FF)
                        If TDR > TPR Then
                            TOut = TPR + (TDR - TPR) / 255 * (255 - TA)
                        Else: TOut = TDR + (TPR - TDR) / 255 * TA
                        End If
                        TOut shl= 8
                        If TDG > TPG Then
                            TOut or= TPG + (TDG - TPG) / 255 * (255 - TA)
                        Else: TOut or= TDG + (TPG - TDG) / 255 * TA
                        End If
                        TOut shl= 8
                        If TDB > TPB Then
                            TOut or= TPB + (TDB - TPB) / 255 * (255 - TA)
                        Else: TOut or= TDB + (TPB - TDB) / 255 * TA
                        End If
                        V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = &HFF000000 or TOut
                    End If
                    TX += 1
                Next
            End If
            TY += 1
        Next
    End If
End If
End Sub



'##############################################################################################################################################################
Sub TPutToFB(ByRef V_TargetImage as FB.Image Ptr, ByRef V_SourceImage as TImage Ptr)
Dim TW as Integer
Dim TH as Integer
Dim TPitch as Integer
Dim TPixels as Any Ptr
Dim TRowT As UInteger Ptr
Dim TRowS As UInteger Ptr
If 0 <> ImageInfo(V_TargetImage, TW, TH, , TPitch, TPixels) Then Exit Sub
If TW <> V_SourceImage->V_Width Then Exit Sub
If TH <> V_SourceImage->V_Height Then Exit Sub
For Y As Integer = 0 To V_SourceImage->V_Height - 1
    memcpy(TPixels + Y * TPitch, V_SourceImage->V_Data + Y * V_SourceImage->V_Width, V_SourceImage->V_Width * 4 - 1)
'   TRowS = V_SourceImage->V_Data + Y * V_SourceImage->V_Width
'   TRowT = TPixels + Y * TPitch
'   For X As Integer = 0 To V_SourceImage->V_Width - 1
'       TRowT[X] = TRowS[X]
'   Next
Next
End Sub



'##############################################################################################################################################################
Sub TDrawStringGetMaxDimensions(ByRef V_Font as TImage Ptr = 0, ByRef V_Text as String, ByRef R_Width as UInteger, ByRef R_Height as UInteger, ByRef V_CharSpace as Integer = 0, ByRef V_LineSpace as Integer = 0, ByRef V_NoLinebreak as Integer = 0, ByRef V_AutoWordbreak as Integer = 0)
R_Width = 0
R_Height = 0
Dim TFont as TImage Ptr = V_Font
If TFont = 0 Then TFont = TImage_GFX_MainFont
If TFont = 0 Then Exit Sub
If TFont->V_Data = 0 Then TFont = TImage_GFX_MainFont
If TFont = 0 Then Exit Sub
If TFont->V_Data = 0 Then Exit Sub
Dim XX as UInteger = 0
Dim Y as UInteger = 0
Dim TH as UInteger = TFont->V_Height
Dim TFK as Integer
Select Case TFont->V_FontType
    Case FontType_Monospace
        Dim TW as UInteger = TFont->V_Width / 256
        For X as UInteger = 1 to Len(V_Text)
            Select Case V_Text[X - 1]
                Case 13
                Case 10
                    If V_NoLinebreak = 0 Then
                        If (XX * TW) > R_Width Then R_Width = XX * TW
                        Y += 1: XX = 0
                    End If
                Case Else: XX += 1
            End Select
        Next
        If XX > R_Width Then R_Width = XX
        R_Height = (Y * (TH + V_LineSpace)) + TH

    Case FontType_Dynamicspace
        TH = TFont->V_FontH
        For X as UInteger = 1 to Len(V_Text)
            TFK = 0
            Select Case V_Text[X - 1]
                Case 32: XX += TH / 2
                Case 13
                Case 10
                    If V_NoLinebreak = 0 Then
                        If XX > R_Width Then R_Width = XX
                        If V_LineSpace > 0 Then Y += V_LineSpace Else Y += TH + 2
                        XX = 0
                    End If
                Case 194
                    X += 1
                    If X > Len(V_Text) Then Exit For
                    Select Case V_Text[X - 1]
                        Case 176: TFK = 248 '?
                        Case 181: TFK = 230 '?
                        Case 167: TFK = 245 '?
                    End Select
                Case 195
                    X += 1
                    If X > Len(V_Text) Then Exit For
                    Select Case V_Text[X - 1]
                        Case 164: TFK = 132 '?
                        Case 182: TFK = 148 '?
                        Case 188: TFK = 129 '?
                        Case 132: TFK = 142 '?
                        Case 150: TFK = 153 '?
                        Case 156: TFK = 154 '?
                        Case 159: TFK = 225 '?
                    End Select
                Case Else: TFK = V_Text[X - 1]
            End Select
            If TFK > 0 Then
                XX += TFont->V_FontW[TFK]
                If V_CharSpace > 0 Then XX += V_CharSpace Else XX += CInt(TH / 32)
            End If
        Next
        If XX > R_Width Then R_Width = XX
        R_Height = Y + TH + 2

End Select
End Sub



'##############################################################################################################################################################
Sub TDrawString(ByRef V_Target as TImage Ptr, ByRef V_Font as TImage Ptr = 0, ByRef V_Text as String, ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &H00FFFFFF, ByRef V_CharSpace as Integer, ByRef V_LineSpace as Integer = 0, ByRef V_NoLinebreak as Integer = 0, ByRef V_CheckAlpha as Integer = 0)
Dim TFont as TImage Ptr = V_Font
If TFont = 0 Then TFont = TImage_GFX_MainFont
If TFont = 0 Then Exit Sub
If TFont->V_Data = 0 Then TFont = TImage_GFX_MainFont
If TFont = 0 Then Exit Sub
If TFont->V_Data = 0 Then Exit Sub
Dim XX as Integer = 0
Dim Y as UInteger = 0
Dim TH as UInteger = TFont->V_Height
Dim TFK as Integer
Select Case TFont->V_FontType
    Case FontType_Monospace
        Dim TW as UInteger = TFont->V_Width / 256
        For X as UInteger = 1 to Len(V_Text)
            Select Case V_Text[X - 1]
                Case 13
                Case 10: If V_NoLinebreak = 0 Then Y += 1: XX = 0
                Case Else
                    XX += 1
                    TPut(V_Target, V_X + ((XX - 1) * (TW + V_CharSpace)), V_Y + (Y * (TH + V_LineSpace)), TFont, V_Text[X - 1] * TW, 0, TW - 1, TH - 1, &H00FFFFFF, V_Color, , , 1, , 1)
            End Select
        Next

    Case FontType_Dynamicspace
        TH = TFont->V_FontH
        For X as UInteger = 1 to Len(V_Text)
            TFK = 0
            Select Case V_Text[X - 1]
                Case 32: XX += TH / 2
                Case 13
                Case 10
                    If V_NoLinebreak = 0 Then
                        If V_LineSpace > 0 Then Y += V_LineSpace Else Y += TH + 2
                        XX = 0
                    End If
                Case 194
                    X += 1
                    If X > Len(V_Text) Then Exit For
                    Select Case V_Text[X - 1]
                        Case 176: TFK = 248 '?
                        Case 181: TFK = 230 '?
                        Case 167: TFK = 245 '?
                    End Select
                Case 195
                    X += 1
                    If X > Len(V_Text) Then Exit For
                    Select Case V_Text[X - 1]
                        Case 164: TFK = 132 '?
                        Case 182: TFK = 148 '?
                        Case 188: TFK = 129 '?
                        Case 132: TFK = 142 '?
                        Case 150: TFK = 153 '?
                        Case 156: TFK = 154 '?
                        Case 159: TFK = 225 '?
                    End Select
                Case Else: TFK = V_Text[X - 1]
            End Select
            If TFK > 0 Then
                'Print #1, "DS:>" & V_X + XX & "<___>" & V_Y + (Y * (TH + V_LineSpace)) & "<___>" & TFont->V_FontP[TFK] & "<___>" & TFont->V_FontW[TFK] & "<___>" & V_CharSpace & "<"
                TPut(V_Target, V_X + XX, V_Y + Y, TFont, TFont->V_FontP[TFK], TFont->V_FontT, TFont->V_FontW[TFK], TFont->V_FontH, &H00FFFFFF, V_Color, , , 1)
                XX += TFont->V_FontW[TFK]
                If V_CharSpace > 0 Then XX += V_CharSpace Else XX += CInt(TH / 32)
            End If
        Next

End Select
End Sub



'##############################################################################################################################################################
'Sub TGFXInit(ByRef V_MainFontPathName as String)
'If TGFX_MainFont <> 0 Then TImageDestroy(TGFX_MainFont)
'TGFX_MainFont = TLoadImageFromFile(V_MainFontPathName)
'End Sub



'##############################################################################################################################################################
Private Sub TImage.CLS(ByRef V_Color as UInteger = &H00000000)
TCLS(@This, V_Color)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.ReplaceColor(ByRef V_ColorFind as UInteger, ByRef V_ColorReplace as UInteger)
TReplaceColor(@This, V_ColorFind, V_ColorReplace)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.PSET(ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &H00000000)
TPSet(@This, V_X, V_Y, V_Color)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Function TImage.Point(ByRef V_X as Integer, ByRef V_Y as Integer) as UInteger
Return TPoint(@This, V_X, V_Y)
End Function

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.Line(ByRef V_X1 as Integer, ByRef V_Y1 as Integer, ByRef V_X2 as Integer, ByRef V_Y2 as Integer, ByRef V_Color as UInteger = &H00000000, ByRef V_Box as Integer = 0, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
TLine(@This, V_X1, V_Y1, V_X2, V_Y2, V_Color, V_Box, V_Filled, V_LineStyle)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.Circle(ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Radius as Integer, ByRef V_Color as UInteger = &HFFFFFFFF, ByRef V_Filled as Integer = 0, ByRef V_LineStyle as TImage_LineStyle_Enum = LineStyle_Continues)
TCircle(@This, V_X, V_Y, V_Radius, V_Color, V_Filled, V_LineStyle)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.Put(ByRef V_TargetX as Integer, V_TargetY as Integer, ByRef V_SourceImage as TImage Ptr, ByRef V_SourceX as UInteger = 0, ByRef V_SourceY as UInteger = 0, ByRef V_SourceW as UInteger = 0, ByRef V_SourceH as UInteger = 0, ByRef V_CopyMaskColor as UInteger = &HFF000000, ByRef V_PutColor as UInteger = &HFF000000, V_IgnorCopyMaskColor as Integer = 0, V_TransparencyMaskColor as UInteger = &HFF000000)
TPut(@This, V_TargetX, V_TargetY, V_SourceImage, V_SourceX, V_SourceY, V_SourceW, V_SourceH, V_CopyMaskColor, V_PutColor, V_IgnorCopyMaskColor)
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------------------------
Private Sub TImage.DrawString(ByRef V_Font as TImage Ptr = 0, ByRef V_Text as String, ByRef V_X as Integer, ByRef V_Y as Integer, ByRef V_Color as UInteger = &HFFFFFF, ByRef V_CharSpace as Integer = 0, ByRef V_LineSpace as Integer = 0, ByRef V_NoLinebreak as Integer = 0, ByRef V_CheckAlpha as Integer = 0)
TDrawString(@This, V_Font, V_Text, V_X, V_Y, V_Color, V_CharSpace, V_LineSpace, V_NoLinebreak, V_CheckAlpha)
End Sub