Home

Add

Edit

Without Linenumbers

Code in Textfield

Ganz unten findet man ein kleines Beispiel zur verwendugn von TImage:


Das TImage Modul:

  1. '##############################################################################################################################################################
    
  2. '##############################################################################################################################################################
    
  3. '### TImage - V:1.00.0 - R:0
    
  4. '##############################################################################################################################################################
    
  5. '##############################################################################################################################################################
    
  6. '### Date of Idea:  2013.02.22 - 23:46:16
    
  7. '### Autor:         DeltaLab's Germany [Experimental Computing]
    
  8. '###                Martin Wiemann
    
  9. '### Contact:       FB[At]MLN[Dot]ath[Dot]cx   /   FB[At]DeltaLabs[Dot]de   /   IRC://MLN.ath.cx/#mln
    
  10. '### Licence:       Tu was du nicht lassen kannst, solange du hiermit nicht mehr Geld verdienst als ich.
    
  11. '##############################################################################################################################################################
    
  12. '##############################################################################################################################################################
    
  13. 
    
  14. 
    
  15. 
    
  16. '##############################################################################################################################################################
    
  17. #IF Defined(TImage_FreeImage)
    
  18.     #INCLUDE Once "FreeImage.bi"
    
  19. #ENDIF
    
  20. #INCLUDE Once "crt/string.bi"
    
  21. 
    
  22. 
    
  23. 
    
  24. '##############################################################################################################################################################
    
  25. Enum TImage_LineStyle_Enum
    
  26.     LineStyle_Continues                 = 0
    
  27.     LineStyle_Dot
    
  28.     LineStyle_Dash
    
  29.     LineStyle_DotDash
    
  30.     LineStyle_Step2
    
  31.     LineStyle_Max
    
  32. End Enum
    
  33. 
    
  34. 
    
  35. 
    
  36. '##############################################################################################################################################################
    
  37. Type TImage
    
  38.     V_Width                             As Uinteger
    
  39.     V_Height                            As Uinteger
    
  40.     V_BPP                               As Uinteger
    
  41.     V_Data                              As Uinteger Ptr
    
  42.     
    
  43.     Declare Sub         Cls             (Byref V_Color As Uinteger = &H00000000)
    
  44.     Declare Sub         ReplaceColor    (Byref V_ColorFind As Uinteger, Byref V_ColorReplace As Uinteger)
    
  45.     Declare Sub         Pset            (Byref V_X As Integer, Byref V_Y As Integer, Byref V_Color As Uinteger = &H00000000)
    
  46.     Declare Function    Point           (Byref V_X As Integer, Byref V_Y As Integer) As Uinteger
    
  47.     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)
    
  48.     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)
    
  49.     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)
    
  50.     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)
    
  51. End Type
    
  52. 
    
  53. 
    
  54. 
    
  55. '##############################################################################################################################################################
    
  56. Dim Shared TImage_GFX_MainFont As TImage Ptr
    
  57. 
    
  58. 
    
  59. 
    
  60. '##############################################################################################################################################################
    
  61. 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
    
  62. If (V_Width <= 0) Or (V_Height <= 0) Or (Fix(V_BPP / 8)) <= 0 Then Return 0
    
  63. Dim TImg As TImage
    
  64. With TImg
    
  65.     .V_Width    = V_Width
    
  66.     .V_Height   = V_Height
    
  67.     .V_BPP      = V_BPP
    
  68.     If V_AllocMem = 0 Then
    
  69.         .V_Data = Callocate(V_Width * V_Height * Fix(V_BPP / 8))
    
  70.     Else: .V_Data = V_AllocMem
    
  71.     End If
    
  72. End With
    
  73. Dim TImgPtr As TImage Ptr = Callocate(Sizeof(TImage))
    
  74. *TImgPtr = TImg
    
  75. Return TImgPtr
    
  76. End Function
    
  77. 
    
  78. 
    
  79. 
    
  80. '##############################################################################################################################################################
    
  81. Sub TImageDestroy(Byref V_Image As TImage Ptr)
    
  82. If V_Image = 0 Then Exit Sub
    
  83. If V_Image->V_Data <> 0 Then Deallocate(V_Image->V_Data)
    
  84. Deallocate(V_Image)
    
  85. V_Image = 0
    
  86. End Sub
    
  87. 
    
  88. 
    
  89. 
    
  90. '##############################################################################################################################################################
    
  91. 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
    
  92. Dim TImg As TImage Ptr
    
  93. #IF Defined(TFreeImage)
    
  94.     Dim FIF As FREE_IMAGE_FORMAT
    
  95.     Dim dib As FIBITMAP Ptr
    
  96.     Dim dib32 As FIBITMAP Ptr
    
  97.     Dim DIBWidth As Uinteger
    
  98.     Dim DIBHeight As Uinteger
    
  99.     Dim flags As Uinteger
    
  100.     Dim Bits As Any Ptr
    
  101.     FIF = FreeImage_GetFileType(Strptr(V_FilePathName), 0)
    
  102.     If FIF = FIF_UNKNOWN Then FIF = FreeImage_GetFIFFromFilename(Strptr(V_FilePathName))
    
  103.     If FIF = FIF_UNKNOWN Then Return NULL
    
  104.     If FIF = FIF_JPEG Then flags = JPEG_ACCURATE
    
  105.     dib = FreeImage_Load(FIF, Strptr(V_FilePathName), flags)
    
  106.     If dib = 0 Then Return NULL
    
  107.     DIBWidth = FreeImage_GetWidth(dib)
    
  108.     DIBHeight = FreeImage_GetHeight(dib)
    
  109.     TImg = TImageCreate(DIBWidth, DIBHeight, 32)
    
  110.     If TImg = 0 Then FreeImage_Unload dib: Return 0
    
  111.     FreeImage_FlipVertical Dib
    
  112.     Dib32 = FreeImage_ConvertTo32Bits(Dib)
    
  113.     Bits = FreeImage_GetBits(Dib32)
    
  114.     #IF Defined(__FB_WIN32__)
    
  115.         movememory Cast(Ubyte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  116.     #ELSEIF Defined(__FB_LINUX__)
    
  117.         memcpy Cast(Ubyte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  118.     #ENDIF
    
  119.     R_Width = DIBWidth
    
  120.     R_Height = DIBHeight
    
  121.     FreeImage_Unload dib
    
  122.     FreeImage_Unload dib32
    
  123. #ELSE
    
  124.     If R_FileMutex <> 0 Then Mutexlock(R_FileMutex)
    
  125.     If Dir(V_FilePathName, -1) = "" Then
    
  126.         If R_FileMutex <> 0 Then Mutexunlock(R_FileMutex)
    
  127.         Return 0
    
  128.     End If
    
  129.     Dim TFNID As Integer = Freefile()
    
  130.     If Open(V_FilePathName For Binary Access Read As #TFNID)    <> 0 Then Return 0
    
  131.     If R_FileMutex <> 0 Then Mutexunlock(R_FileMutex)
    
  132.     Dim TSig            As Ushort   :   If Get(#TFNID, , TSig)      <> 0 Then Close #TFNID: Return 0
    
  133.     Dim TSize           As Uinteger :   If Get(#TFNID, , TSize)     <> 0 Then Close #TFNID: Return 0
    
  134.     Dim TRes1           As Ushort   :   If Get(#TFNID, , TRes1)     <> 0 Then Close #TFNID: Return 0
    
  135.     Dim TRes2           As Ushort   :   If Get(#TFNID, , TRes2)     <> 0 Then Close #TFNID: Return 0
    
  136.     Dim TOffset         As Uinteger :   If Get(#TFNID, , TOffset)   <> 0 Then Close #TFNID: Return 0
    
  137.     If TSig         <> &H4D42 Then Close #TFNID: Return 0
    
  138.     If TSize         < 1 Then Close #TFNID: Return 0
    
  139.     Dim TDIBSize        As Uinteger :   If Get(#TFNID, , TDIBSize)  <> 0 Then Close #TFNID: Return 0
    
  140.     Dim TWidth          As Integer  :   If Get(#TFNID, , TWidth)    <> 0 Then Close #TFNID: Return 0
    
  141.     Dim THeight         As Integer  :   If Get(#TFNID, , THeight)   <> 0 Then Close #TFNID: Return 0
    
  142.     Dim TPlanes         As Ushort   :   If Get(#TFNID, , TPlanes)   <> 0 Then Close #TFNID: Return 0
    
  143.     Dim TBPP            As Ushort   :   If Get(#TFNID, , TBPP)      <> 0 Then Close #TFNID: Return 0
    
  144.     Dim TCompress       As Uinteger :   If Get(#TFNID, , TCompress) <> 0 Then Close #TFNID: Return 0
    
  145.     Dim TImgSize        As Uinteger :   If Get(#TFNID, , TImgSize)  <> 0 Then Close #TFNID: Return 0
    
  146.     Dim TXPPM           As Uinteger :   If Get(#TFNID, , TXPPM)     <> 0 Then Close #TFNID: Return 0
    
  147.     Dim TYPPM           As Uinteger :   If Get(#TFNID, , TYPPM)     <> 0 Then Close #TFNID: Return 0
    
  148.     Dim TCCT            As Uinteger :   If Get(#TFNID, , TCCT)      <> 0 Then Close #TFNID: Return 0
    
  149.     Dim TICC            As Uinteger :   If Get(#TFNID, , TICC)      <> 0 Then Close #TFNID: Return 0
    
  150.     Dim TMask(0 To 3)   As Uinteger
    
  151.     If Get(#TFNID, , TMask(0)) <> 0 Then Close #TFNID: Return 0
    
  152.     If Get(#TFNID, , TMask(1)) <> 0 Then Close #TFNID: Return 0
    
  153.     If Get(#TFNID, , TMask(2)) <> 0 Then Close #TFNID: Return 0
    
  154.     If Get(#TFNID, , TMask(3)) <> 0 Then Close #TFNID: Return 0
    
  155.     If TWidth        < 1 Then Close #TFNID: Return 0
    
  156.     If THeight       < 1 Then Close #TFNID: Return 0
    
  157.     If TPlanes      <> 1 Then Close #TFNID: Return 0
    
  158.     If TBPP          < 1 Then Close #TFNID: Return 0
    
  159.     If TCompress    <> 0 Then Close #TFNID: Return 0
    
  160.     Dim T As String
    
  161.     Dim X As Integer
    
  162.     Dim Y As Integer
    
  163.     Seek #TFNID, TOffset + 1
    
  164.     Select Case TBPP
    
  165.         Case 24
    
  166.             Y = TWidth * (TBPP / 8)
    
  167.             If (Y Mod 4) <> 0 Then Y = Fix(TWidth * (TBPP / 8) / 4) * 4 + 4
    
  168.             T = Space(Y)
    
  169.             TImg = TImageCreate(TWidth, THeight)
    
  170.             For Y = THeight - 1 To 0 Step -1
    
  171.                 Get #TFNID, , T
    
  172.                 For X = 0 To TWidth * (TBPP / 8) - 1 Step (TBPP / 8)
    
  173.                     TImg->V_Data[Y * TWidth + (X / (TBPP / 8))] = (T[X + 2] Shl 16) Or (T[X + 1] Shl 8) Or T[X]
    
  174.                 Next
    
  175.             Next
    
  176.         Case Else: Close #TFNID: Return 0
    
  177.     End Select
    
  178.     Close #TFNID
    
  179. #ENDIF
    
  180. Return TImg
    
  181. End Function
    
  182. 
    
  183. 
    
  184. 
    
  185. '###############################################################################################################################################
    
  186. 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
    
  187. Dim TImg As TImage Ptr
    
  188. #IF Defined(TFreeImage)
    
  189.     If Len(V_Data) <= 0 Then Return 0
    
  190.     Dim MEM As FIMEMORY Ptr
    
  191.     MEM = FreeImage_OpenMemory(Cast(Byte Ptr, @V_Data[0]), Len(V_Data))
    
  192.     If MEM = 0 Then Return 0
    
  193.     Dim DIB As FIBITMAP Ptr
    
  194.     DIB = FreeImage_LoadFromMemory(FIF_JPEG, MEM, JPEG_DEFAULT)
    
  195.     If DIB = 0 Then FreeImage_CloseMemory(MEM): Return 0
    
  196.     Dim DIBWidth As Integer = Cast(Integer, FreeImage_GetWidth(DIB))
    
  197.     Dim DIBHeight As Integer = Cast(Integer, FreeImage_GetHeight(DIB))
    
  198.     If (DIBWidth <= 0) Or (DIBHeight <= 0) Then FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    
  199.     FreeImage_FlipVertical(DIB)
    
  200.     Dim DIB32 As FIBITMAP Ptr = FreeImage_ConvertTo32Bits(DIB)
    
  201.     If DIB32 = 0 Then FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    
  202.     TImg = TImageCreate(DIBWidth, DIBHeight, 32)
    
  203.     If TImg = 0 Then FreeImage_Unload(DIB32): FreeImage_Unload(DIB): FreeImage_CloseMemory(MEM): Return 0
    
  204.     Dim Bits As Any Ptr = FreeImage_GetBits(DIB32)
    
  205.     #IF Defined(__FB_WIN32__)
    
  206.         movememory Cast(Ubyte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  207.     #ELSEIF Defined(__FB_LINUX__)
    
  208.         memcpy Cast(Ubyte Ptr, TImg->V_Data), Bits, DIBWidth * DIBHeight * 4
    
  209.     #ENDIF
    
  210.     R_Width = DIBWidth
    
  211.     R_Height = DIBHeight
    
  212.     FreeImage_Unload(DIB32)
    
  213.     FreeImage_Unload(DIB)
    
  214.     FreeImage_CloseMemory(MEM)
    
  215. #ELSE
    
  216.     
    
  217. #ENDIF
    
  218. Return TImg
    
  219. End Function
    
  220. 
    
  221. 
    
  222. 
    
  223. '##############################################################################################################################################################
    
  224. Function TImageScale(Byref V_Image As TImage Ptr, V_Width As Uinteger, V_Height As Uinteger, V_ScaleType As Integer = 1) As TImage Ptr
    
  225. If V_Image = 0 Then Return 0
    
  226. If V_Width <= 0 Then Return 0
    
  227. If V_Height <= 0 Then Return 0
    
  228. Dim TImg As TImage Ptr = TImageCreate(V_Width, V_Height, V_Image->V_BPP)
    
  229. Dim TW As Uinteger = V_Image->V_Width
    
  230. Dim TH As Uinteger = V_Image->V_Height
    
  231. If V_Width > V_Image->V_Width Then TW = V_Width
    
  232. If V_Height > V_Image->V_Height Then TH = V_Height
    
  233. Dim TSourceW As Uinteger = V_Image->V_Width * V_Image->V_Height
    
  234. Dim TTargetW As Uinteger = TImg->V_Width * TImg->V_Height
    
  235. Dim TSourceDW As Single = V_Image->V_Width / TW
    
  236. Dim TSourceDH As Single = V_Image->V_Height / TH
    
  237. Dim TTargetDW As Single = TImg->V_Width / TW
    
  238. Dim TTargetDH As Single = TImg->V_Height / TH
    
  239. Dim TSourceL As Uinteger
    
  240. Dim TTargetL As Uinteger
    
  241. Dim TSourceP As Integer
    
  242. Dim TTargetP As Integer
    
  243. Dim X As Integer
    
  244. Dim Y As Integer
    
  245. 
    
  246. Select Case V_ScaleType
    
  247.     Case 0 'BilineareInterpolation
    
  248.         For Y = 0 To TH - 1
    
  249.             For X = 0 To TW - 1
    
  250.                 TSourceP = Cint(Fix(TSourceDH * Y) * V_Image->V_Width + Fix(TSourceDW * X))
    
  251.                 TTargetP = Cint(Fix(TTargetDH * Y) * TImg->V_Width + Fix(TTargetDW * X))
    
  252.                 TImg->V_Data[TTargetP] = V_Image->V_Data[TSourceP]
    
  253.             Next
    
  254.         Next
    
  255.         
    
  256.     Case Else 'NearestNeighbor
    
  257.         For Y = 0 To TH - 1
    
  258.             TSourceL = Fix(TSourceDH * Y) * V_Image->V_Width
    
  259.             TTargetL = Fix(TTargetDH * Y) * TImg->V_Width
    
  260.             For X = 0 To TW - 1
    
  261.                 TSourceP = Cint(TSourceL + Fix(TSourceDW * X))
    
  262.                 TTargetP = Cint(TTargetL + Fix(TTargetDW * X))
    
  263.                 TImg->V_Data[TTargetP] = V_Image->V_Data[TSourceP]
    
  264.             Next
    
  265.         Next
    
  266.         
    
  267. End Select
    
  268. Return TImg
    
  269. End Function
    
  270. 
    
  271. 
    
  272. 
    
  273. '##############################################################################################################################################################
    
  274. Sub TCLS(Byref V_Image As TImage Ptr, Byref V_Color As Uinteger = &H00000000)
    
  275. If V_Image = 0 Then Exit Sub
    
  276. With *V_Image
    
  277.     Dim TW As Uinteger = .V_Width * 4
    
  278.     Dim TMem As Uinteger Ptr = Allocate(TW)
    
  279.     For X As Uinteger = 0 To .V_Width - 1
    
  280.         TMem[X] = V_Color
    
  281.     Next
    
  282.     For X As Uinteger = 0 To .V_Height - 1
    
  283.         memcpy(@.V_Data[X * .V_Width], TMem, TW)
    
  284.     Next
    
  285.     Deallocate(TMem)
    
  286. End With
    
  287. End Sub
    
  288. 
    
  289. 
    
  290. 
    
  291. '##############################################################################################################################################################
    
  292. Sub TReplaceColor(Byref V_Image As TImage Ptr, Byref V_ColorFind As Uinteger, Byref V_ColorReplace As Uinteger)
    
  293. If V_Image = 0 Then Exit Sub
    
  294. With *V_Image
    
  295.     For X As Uinteger = 0 To .V_Height * .V_Width - 1
    
  296.         If .V_Data[X] = V_ColorFind Then .V_Data[X] = V_ColorReplace
    
  297.     Next
    
  298. End With
    
  299. End Sub
    
  300. 
    
  301. 
    
  302. 
    
  303. '##############################################################################################################################################################
    
  304. #MACRO TPSet(V_Image, V_X, V_Y, V_Color)
    
  305. If V_Image <> 0 Then
    
  306.     With *V_Image
    
  307.         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
    
  308.     End With
    
  309. End If
    
  310. #ENDMACRO
    
  311. 
    
  312. 
    
  313. 
    
  314. '##############################################################################################################################################################
    
  315. Function TPoint(Byref V_Image As TImage Ptr, Byref V_X As Integer, Byref V_Y As Integer) As Uinteger
    
  316. If V_Image = 0 Then Return 0
    
  317. With *V_Image
    
  318.     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]
    
  319. End With
    
  320. Return 0
    
  321. End Function
    
  322. 
    
  323. 
    
  324. 
    
  325. '##############################################################################################################################################################
    
  326. #MACRO TINT_Point_SetVal(RV_DataPtr, V_Color, V_LineStyle, RV_TC)
    
  327. Select Case V_LineStyle
    
  328.     Case LineStyle_Continues
    
  329.         RV_DataPtr = V_Color
    
  330.         
    
  331.     Case LineStyle_Dot
    
  332.         If RV_TC = 0 Then
    
  333.             RV_DataPtr = V_Color
    
  334.             RV_TC = 1
    
  335.         Else: RV_TC = 0
    
  336.         End If
    
  337.         
    
  338.     Case LineStyle_DotDash
    
  339.         RV_TC += 1
    
  340.         Select Case RV_TC
    
  341.             Case 1: RV_DataPtr = V_Color
    
  342.             Case 2 To 3
    
  343.             Case 4 To 7: RV_DataPtr = V_Color
    
  344.             Case 8
    
  345.             Case Else: RV_TC = 0
    
  346.         End Select
    
  347.         
    
  348.     Case LineStyle_Dash
    
  349.         RV_TC += 1
    
  350.         Select Case RV_TC
    
  351.             Case 1 To 4: RV_DataPtr = V_Color
    
  352.             Case 5 To 8
    
  353.             Case Else: RV_TC = 0
    
  354.         End Select
    
  355.         
    
  356.     Case LineStyle_Step2
    
  357.         RV_TC += 1
    
  358.         Select Case RV_TC
    
  359.             Case 1 To 2: RV_DataPtr = V_Color
    
  360.             Case 3 To 4
    
  361.             Case Else: RV_TC = 0
    
  362.         End Select
    
  363.         
    
  364. End Select
    
  365. #ENDMACRO
    
  366. 
    
  367. 
    
  368. 
    
  369. '##############################################################################################################################################################
    
  370. 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)
    
  371. If V_Image = 0 Then Exit Sub
    
  372. If V_Image->V_Data = 0 Then Exit Sub
    
  373. Dim TX1 As Integer = V_X1
    
  374. Dim TX2 As Integer = V_X2
    
  375. Dim TY1 As Integer = V_Y1
    
  376. Dim TY2 As Integer = V_Y2
    
  377. Dim TC1 As Uinteger
    
  378. Dim TC2 As Uinteger
    
  379. Dim TD1 As Uinteger
    
  380. Dim TD2 As Uinteger
    
  381. Dim TW1 As Uinteger
    
  382. Dim TMDLen As Uinteger = V_Image->V_Width * V_Image->V_Height
    
  383. With *V_Image
    
  384.     If V_Box = 1 Then
    
  385.         If TX1 < 0 Then TX1 = 0
    
  386.         If TX1 >= .V_Width Then TX1 = .V_Width - 1
    
  387.         If TX2 < 0 Then TX2 = 0
    
  388.         If TX2 >= .V_Width Then TX2 = .V_Width - 1
    
  389.         If TY1 < 0 Then TY1 = 0
    
  390.         If TY1 >= .V_Height Then TY1 = .V_Height - 1
    
  391.         If TY2 < 0 Then TY2 = 0
    
  392.         If TY2 >= .V_Height Then TY2 = .V_Height - 1
    
  393.         If TX1 > TX2 Then Swap TX1, TX2
    
  394.         If TY1 > TY2 Then Swap TY1, TY2
    
  395.         If V_Filled = 1 Then
    
  396.             If V_LineStyle <> LineStyle_Continues Then
    
  397.                 For Y As Integer = TY1 To TY2
    
  398.                     If TC2 = 0 Then TC2 = 1 Else TC2 = 0
    
  399.                     TC1 = TC2
    
  400.                     For X As Integer = TX1 To TX2
    
  401.                         TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + X], V_Color, V_LineStyle, TC1)
    
  402.                     Next
    
  403.                 Next
    
  404.             Else
    
  405.                 For Y As Integer = TY1 To TY2
    
  406.                     For X As Integer = TX1 To TX2
    
  407.                         V_Image->V_Data[Y * .V_Width + X] = V_Color
    
  408.                     Next
    
  409.                 Next
    
  410.             End If
    
  411.         Else
    
  412.             For X As Integer = TX1 To TX2
    
  413.                 TINT_Point_SetVal(V_Image->V_Data[TY1 * .V_Width + X], V_Color, V_LineStyle, TC1)
    
  414.                 TINT_Point_SetVal(V_Image->V_Data[TY2 * .V_Width + X], V_Color, V_LineStyle, TC2)
    
  415.             Next
    
  416.             For Y As Integer = TY1 To TY2
    
  417.                 TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX1], V_Color, V_LineStyle, TC1)
    
  418.                 TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX2], V_Color, V_LineStyle, TC2)
    
  419.             Next
    
  420.         End If
    
  421.     Else
    
  422.         If TX1 = TX2 Then
    
  423.             If TX1 < 0 Then TX1 = 0
    
  424.             If TX1 >= .V_Width Then TX1 = .V_Width - 1
    
  425.             If TX2 < 0 Then TX2 = 0
    
  426.             If TX2 >= .V_Width Then TX2 = .V_Width - 1
    
  427.             If TY1 < 0 Then TY1 = 0
    
  428.             If TY1 >= .V_Height Then TY1 = .V_Height - 1
    
  429.             If TY2 < 0 Then TY2 = 0
    
  430.             If TY2 >= .V_Height Then TY2 = .V_Height - 1
    
  431.             If TX1 > TX2 Then Swap TX1, TX2
    
  432.             If TY1 > TY2 Then Swap TY1, TY2
    
  433.             For Y As Integer = TY1 To TY2
    
  434.                 TINT_Point_SetVal(V_Image->V_Data[Y * .V_Width + TX1], V_Color, V_LineStyle, TC1)
    
  435.             Next
    
  436.         Elseif TY1 = TY2 Then
    
  437.             If TX1 < 0 Then TX1 = 0
    
  438.             If TX1 >= .V_Width Then TX1 = .V_Width - 1
    
  439.             If TX2 < 0 Then TX2 = 0
    
  440.             If TX2 >= .V_Width Then TX2 = .V_Width - 1
    
  441.             If TY1 < 0 Then TY1 = 0
    
  442.             If TY1 >= .V_Height Then TY1 = .V_Height - 1
    
  443.             If TY2 < 0 Then TY2 = 0
    
  444.             If TY2 >= .V_Height Then TY2 = .V_Height - 1
    
  445.             If TX1 > TX2 Then Swap TX1, TX2
    
  446.             If TY1 > TY2 Then Swap TY1, TY2
    
  447.             For X As Integer = TX1 To TX2
    
  448.                 TINT_Point_SetVal(V_Image->V_Data[TY1 * .V_Width + X], V_Color, V_LineStyle, TC1)
    
  449.             Next
    
  450.         Else
    
  451.             Dim TMultiplier As Double
    
  452.             If Abs(TX2 - TX1) > Abs(TY2 - TY1) Then
    
  453.                 TMultiplier = (TY2 - TY1) / (TX2 - TX1)
    
  454.                 For X As Integer = Iif(TX1 < TX2, TX1, TX2) To Iif(TX1 < TX2, TX2, TX1)
    
  455.                     If X >= .V_Width Then Exit For
    
  456.                     If X >= 0 Then
    
  457.                         TD1 = (Cint(TY1 + (X - TX1) * TMultiplier) * .V_Width + X)
    
  458.                         If TMDLen > TD1 Then
    
  459.                             TINT_Point_SetVal(V_Image->V_Data[TD1], V_Color, V_LineStyle, TC1)
    
  460.                         End If
    
  461.                     End If
    
  462.                 Next
    
  463.             Else
    
  464.                 TMultiplier = (TX2 - TX1) / (TY2 - TY1)
    
  465.                 TW1 = (.V_Width - 1)
    
  466.                 For Y As Integer = Iif(TY1 < TY2, TY1, TY2) To Iif(TY1 < TY2, TY2, TY1)
    
  467.                     If Y >= .V_Height Then Exit For
    
  468.                     If Y >= 0 Then
    
  469.                         TD1 = (TX1 + (Y - TY1) * TMultiplier)
    
  470.                         TD2 = Cint(Y * .V_Width) + TD1
    
  471.                         If TMDLen > TD2 Then
    
  472.                             If (TD1 >= 0) And (TD1 < TW1) Then
    
  473.                                 TINT_Point_SetVal(V_Image->V_Data[TD2], V_Color, V_LineStyle, TC1)
    
  474.                             End If
    
  475.                         End If
    
  476.                     End If
    
  477.                 Next
    
  478.             End If
    
  479.         End If
    
  480.     End If
    
  481. End With
    
  482. End Sub
    
  483. 
    
  484. 
    
  485. 
    
  486. '##############################################################################################################################################################
    
  487. 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)
    
  488. If V_Image = 0 Then Exit Sub
    
  489. If V_Image->V_Data = 0 Then Exit Sub
    
  490. Dim TMDLen As Uinteger = V_Image->V_Width * V_Image->V_Height
    
  491. With *V_Image
    
  492.     Dim D As Double = -V_Radius
    
  493.     Dim Y As Double
    
  494.     Dim X As Double = V_Radius
    
  495.     Dim TW1 As Uinteger
    
  496.     Dim TC1(8) As Uinteger
    
  497.     Dim TV As Integer
    
  498.     If V_Filled = 0 Then
    
  499.         Do Until Y > X
    
  500.             TW1 = (V_X + X)
    
  501.             If (TW1 >= 0) And (TW1 < .V_Width) Then
    
  502.                 TV = (TW1 + (V_Y + Y) * .V_Width)
    
  503.                 If (TV >= 0) And (TV < TMDLen) Then
    
  504.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  505.                 End If
    
  506.                 TV = (TW1 + (V_Y + V_Radius - Y - V_Radius) * .V_Width)
    
  507.                 If (TV >= 0) And (TV < TMDLen) Then
    
  508.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(2))
    
  509.                 End If
    
  510.             End If
    
  511.             TW1 = (V_X + V_Radius - X - V_Radius)
    
  512.             If (TW1 >= 0) And (TW1 < .V_Width) Then
    
  513.                 TV = (TW1 + (V_Y + Y) * .V_Width)
    
  514.                 If (TV >= 0) And (TV < TMDLen) Then
    
  515.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(3))
    
  516.                 End If
    
  517.                 TV = TW1 + (V_Y + V_Radius - Y - V_Radius) * .V_Width
    
  518.                 If (TV >= 0) And (TV < TMDLen) Then
    
  519.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(4))
    
  520.                 End If
    
  521.             End If
    
  522.             TW1 = (V_X + Y)
    
  523.             If (TW1 >= 0) And (TW1 < .V_Width) Then
    
  524.                 TV = TW1 + (V_Y + X) * .V_Width
    
  525.                 If (TV >= 0) And (TV < TMDLen) Then
    
  526.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(5))
    
  527.                 End If
    
  528.                 TV = (TW1 + (V_Y + V_Radius - X - V_Radius) * .V_Width)
    
  529.                 If (TV >= 0) And (TV < TMDLen) Then
    
  530.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(6))
    
  531.                 End If
    
  532.             End If
    
  533.             TW1 = (V_X + V_Radius - Y - V_Radius)
    
  534.             If (TW1 >= 0) And (TW1 < .V_Width) Then
    
  535.                 TV = (TW1 + (V_Y + X) * .V_Width)
    
  536.                 If (TV >= 0) And (TV < TMDLen) Then
    
  537.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(7))
    
  538.                 End If
    
  539.                 TV = (TW1 + (V_Y + V_Radius - X - V_Radius) * .V_Width)
    
  540.                 If (TV >= 0) And (TV < TMDLen) Then
    
  541.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(8))
    
  542.                 End If
    
  543.             End If
    
  544.             D = D + 2 * Y + 1
    
  545.             Y = Y + 1
    
  546.             If D > 0 Then
    
  547.                 D = D - 2 * X + 2
    
  548.                 X = X - 1
    
  549.             End If
    
  550.         Loop
    
  551.     Else
    
  552.         Dim TY As Integer
    
  553.         Dim TYL1 As Double
    
  554.         Dim TYL2 As Double
    
  555.         Dim TX1a As Double
    
  556.         Dim TX1b As Double
    
  557.         Dim TX2a As Double
    
  558.         Dim TX2b As Double
    
  559.         Dim T1i As Integer
    
  560.         Dim T2i As Integer
    
  561.         Dim TModX As Integer
    
  562.         Select Case V_LineStyle
    
  563.             Case LineStyle_Continues    : TModX = 1
    
  564.             Case LineStyle_Dot          : TModX = 2
    
  565.             Case LineStyle_DotDash      : TModX = 8
    
  566.             Case LineStyle_Dash         : TModX = 4
    
  567.             Case LineStyle_Step2        : TModX = 2
    
  568.         End Select
    
  569.         Do Until Y > X
    
  570.             TY = V_Y + Y
    
  571.             If (TY >= 0) And (TY < .V_Height) Then
    
  572.                 TC1(1) = (TY + V_X + V_Radius - X - V_Radius) Mod TModX
    
  573.                 For XX As Integer = V_X + V_Radius - X - V_Radius To V_X + X
    
  574.                     If (XX >= 0) And (XX < .V_Width) Then
    
  575.                         TV = Int(XX + TY * .V_Width)
    
  576.                         If (TV >= 0) And (TV < TMDLen) Then
    
  577.                             TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  578.                         End If
    
  579.                     End If
    
  580.                 Next
    
  581.                 TY = V_Y + V_Radius - Y - V_Radius
    
  582.                 TC1(1) = (TY + V_X + V_Radius - X - V_Radius) Mod TModX
    
  583.                 For XX As Integer = V_X + V_Radius - X - V_Radius To V_X + X
    
  584.                     If (XX >= 0) And (XX < .V_Width) Then
    
  585.                         TV = Int(XX + TY * .V_Width)
    
  586.                         If (TV >= 0) And (TV < TMDLen) Then
    
  587.                             TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  588.                         End If
    
  589.                     End If
    
  590.                 Next
    
  591.                 TY = V_Y + X
    
  592.                 If TYL1 <> TY Then
    
  593.                     If T1i = 1 Then
    
  594.                         TC1(1) = (TY + TX1a - 1) Mod TModX
    
  595.                         For XX As Double = TX1a To TX1b
    
  596.                             If (XX >= 0) And (XX < .V_Width) Then
    
  597.                                 TV = Int(XX + TYL1 * .V_Width)
    
  598.                                 If (TV >= 0) And (TV < TMDLen) Then
    
  599.                                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  600.                                 End If
    
  601.                             End If
    
  602.                         Next
    
  603.                     End If
    
  604.                     T1i = 1
    
  605.                     TYL1 = TY
    
  606.                 End If
    
  607.                 TX1a = V_X + V_Radius - Y - V_Radius
    
  608.                 TX1b = V_X + Y
    
  609.                 TY = V_Y + V_Radius - X - V_Radius
    
  610.                 If TYL2 <> TY Then
    
  611.                     If T2i = 1 Then
    
  612.                         TC1(1) = (TY + TX2a - 1) Mod TModX
    
  613.                         For XX As Double = TX2a To TX2b
    
  614.                             If (XX >= 0) And (XX < .V_Width) Then
    
  615.                                 TV = Int(XX + TYL2 * .V_Width)
    
  616.                                 If (TV >= 0) And (TV < TMDLen) Then
    
  617.                                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  618.                                 End If
    
  619.                             End If
    
  620.                         Next
    
  621.                     End If
    
  622.                     T2i = 1
    
  623.                     TYL2 = TY
    
  624.                 End If
    
  625.                 TX2a = V_X + V_Radius - Y - V_Radius
    
  626.                 TX2b = V_X + Y
    
  627.             End If
    
  628.             D = D + 2 * Y + 1
    
  629.             Y = Y + 1
    
  630.             If D > 0 Then
    
  631.                 D = D - 2 * X + 2
    
  632.                 X = X - 1
    
  633.             End If
    
  634.         Loop
    
  635.         TC1(1) = (TY + TX2a) Mod TModX
    
  636.         For XX As Integer = V_X + V_Radius - Y - V_Radius + 1 To V_X + Y - 1
    
  637.             If (XX >= 0) And (XX < .V_Width) Then
    
  638.                 TV = Int(XX + TYL1 * .V_Width)
    
  639.                 If (TV >= 0) And (TV < TMDLen) Then
    
  640.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  641.                 End If
    
  642.             End If
    
  643.         Next
    
  644.         TC1(1) = (TY + TX1a) Mod TModX
    
  645.         For XX As Integer = V_X + V_Radius - Y - V_Radius + 1 To V_X + Y - 1
    
  646.             If (XX >= 0) And (XX < .V_Width) Then
    
  647.                 TV = Int(XX + TYL2 * .V_Width)
    
  648.                 If (TV >= 0) And (TV < TMDLen) Then
    
  649.                     TINT_Point_SetVal(V_Image->V_Data[TV], V_Color, V_LineStyle, TC1(1))
    
  650.                 End If
    
  651.             End If
    
  652.         Next
    
  653.     End If
    
  654. End With
    
  655. End Sub
    
  656. 
    
  657. 
    
  658. 
    
  659. '##############################################################################################################################################################
    
  660. Function TPut_AlphaBlitter(Byref V_SourcePix As Uinteger, Byref V_DestPix As Uinteger, Byref V_Param As Uinteger) As Uinteger
    
  661. If (V_SourcePix And &HFFFFFF) = &HFF00FF Then Return V_DestPix
    
  662. If (V_SourcePix And &HFFFFFF) = &H000000 Then Return V_DestPix
    
  663. Dim TA As Uinteger = V_SourcePix And &H0000FF
    
  664. Dim TDR As Uinteger = (V_DestPix And &HFF0000) Shr 16
    
  665. Dim TDG As Uinteger = (V_DestPix And &H00FF00) Shr 8
    
  666. Dim TDB As Uinteger = (V_DestPix And &H0000FF)
    
  667. Dim TPR As Uinteger = (V_Param And &HFF0000) Shr 16
    
  668. Dim TPG As Uinteger = (V_Param And &H00FF00) Shr 8
    
  669. Dim TPB As Uinteger = (V_Param And &H0000FF)
    
  670. Dim TOut As Uinteger
    
  671. If TDR > TPR Then
    
  672.     TOut = TPR + (TDR - TPR) / 255 * (255 - TA)
    
  673. Else: TOut = TDR + (TPR - TDR) / 255 * TA
    
  674. End If
    
  675. TOut Shl= 8
    
  676. If TDG > TPG Then
    
  677.     TOut Or= TPG + (TDG - TPG) / 255 * (255 - TA)
    
  678. Else: TOut Or= TDG + (TPG - TDG) / 255 * TA
    
  679. End If
    
  680. TOut Shl= 8
    
  681. If TDB > TPB Then
    
  682.     TOut Or= TPB + (TDB - TPB) / 255 * (255 - TA)
    
  683. Else: TOut Or= TDB + (TPB - TDB) / 255 * TA
    
  684. End If
    
  685. Return TOut
    
  686. End Function
    
  687. 
    
  688. 
    
  689. 
    
  690. '##############################################################################################################################################################
    
  691. 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)
    
  692. If V_TargetImage = 0 Then Exit Sub
    
  693. If V_SourceImage = 0 Then Exit Sub
    
  694. If V_TargetImage->V_Data = 0 Then Exit Sub
    
  695. If V_SourceImage->V_Data = 0 Then Exit Sub
    
  696. Dim SX1 As Integer = V_SourceX
    
  697. Dim SY1 As Integer = V_SourceY
    
  698. Dim SX2 As Integer = V_SourceX + V_SourceW
    
  699. Dim SY2 As Integer = V_SourceY + V_SourceH
    
  700. If (V_SourceX = 0) And (V_SourceY = 0) And (V_SourceW = 0) And (V_SourceH = 0) Then
    
  701.     SX2 = V_SourceImage->V_Width - 1
    
  702.     SY2 = V_SourceImage->V_Height - 1
    
  703. End If
    
  704. If SX2 >= V_SourceImage->V_Width Then SX2 = V_SourceImage->V_Width - 1
    
  705. If SY2 >= V_SourceImage->V_Height Then SY2 = V_SourceImage->V_Height - 1
    
  706. If SX1 >= SX2 Then Exit Sub
    
  707. If SY1 >= SY2 Then Exit Sub
    
  708. Dim X As Integer
    
  709. Dim Y As Integer
    
  710. Dim TX As Integer
    
  711. Dim TY As Integer = V_TargetY
    
  712. If V_IgnorCopyMaskColor = 0 Then
    
  713.     If V_CopyMaskColor <> &HFF000000 Then
    
  714.         If V_UseGrayScaleAsAlpha = 0 Then
    
  715.             For Y = SY1 To SY2
    
  716.                 If (TY >= 0) And (TY < V_TargetImage->V_Height) Then
    
  717.                     TX = V_TargetX
    
  718.                     For X = SX1 To SX2
    
  719.                         If (TX >= 0) And (TX < V_TargetImage->V_Width) Then
    
  720.                             If V_CopyMaskColor = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
    
  721.                                 V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_PutColor
    
  722.                             End If
    
  723.                         End If
    
  724.                         TX += 1
    
  725.                     Next
    
  726.                 End If
    
  727.                 TY += 1
    
  728.             Next
    
  729.         Else
    
  730.             For Y = SY1 To SY2
    
  731.                 If (TY >= 0) And (TY < V_TargetImage->V_Height) Then
    
  732.                     TX = V_TargetX
    
  733.                     For X = SX1 To SX2
    
  734.                         If (TX >= 0) And (TX < V_TargetImage->V_Width) Then
    
  735.                             V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = TPut_AlphaBlitter(V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X], V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX], V_PutColor)
    
  736.                         End If
    
  737.                         TX += 1
    
  738.                     Next
    
  739.                 End If
    
  740.                 TY += 1
    
  741.             Next
    
  742.         End If
    
  743.     Else
    
  744.         For Y = SY1 To SY2
    
  745.             If (TY >= 0) And (TY < V_TargetImage->V_Height) Then
    
  746.                 TX = V_TargetX
    
  747.                 For X = SX1 To SX2
    
  748.                     If (TX >= 0) And (TX < V_TargetImage->V_Width) Then
    
  749.                         If V_TransparencyMaskColor <> V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
    
  750.                             V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X]
    
  751.                         End If
    
  752.                     End If
    
  753.                     TX += 1
    
  754.                 Next
    
  755.             End If
    
  756.             TY += 1
    
  757.         Next
    
  758.     End If
    
  759. Else
    
  760.     For Y = SY1 To SY2
    
  761.         If (TY >= 0) And (TY < V_TargetImage->V_Height) Then
    
  762.             TX = V_TargetX
    
  763.             For X = SX1 To SX2
    
  764.                 If (TX >= 0) And (TX < V_TargetImage->V_Width) Then
    
  765.                     If V_CopyMaskColor <> V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X] Then
    
  766.                         V_TargetImage->V_Data[TY * V_TargetImage->V_Width + TX] = V_SourceImage->V_Data[Y * V_SourceImage->V_Width + X]
    
  767.                     End If
    
  768.                 End If
    
  769.                 TX += 1
    
  770.             Next
    
  771.         End If
    
  772.         TY += 1
    
  773.     Next
    
  774. End If
    
  775. End Sub
    
  776. 
    
  777. 
    
  778. 
    
  779. '##############################################################################################################################################################
    
  780. Sub TPutToFB(Byref V_TargetImage As FB.Image Ptr, Byref V_SourceImage As TImage Ptr)
    
  781. Dim TW As Integer
    
  782. Dim TH As Integer
    
  783. Dim TPitch As Integer
    
  784. Dim TPixels As Any Ptr
    
  785. Dim TRowT As Uinteger Ptr
    
  786. Dim TRowS As Uinteger Ptr
    
  787. If 0 <> ImageInfo(V_TargetImage, TW, TH, , TPitch, TPixels) Then Exit Sub
    
  788. If TW <> V_SourceImage->V_Width Then Exit Sub
    
  789. If TH <> V_SourceImage->V_Height Then Exit Sub
    
  790. For Y As Integer = 0 To V_SourceImage->V_Height - 1
    
  791.     memcpy(TPixels + Y * TPitch, V_SourceImage->V_Data + Y * V_SourceImage->V_Width, V_SourceImage->V_Width * 4 - 1)
    
  792. '   TRowS = V_SourceImage->V_Data + Y * V_SourceImage->V_Width
    
  793. '   TRowT = TPixels + Y * TPitch
    
  794. '   For X As Integer = 0 To V_SourceImage->V_Width - 1
    
  795. '       TRowT[X] = TRowS[X]
    
  796. '   Next
    
  797. Next
    
  798. End Sub
    
  799. 
    
  800. 
    
  801. 
    
  802. '##############################################################################################################################################################
    
  803. 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 = 0, Byref V_LineSpace As Integer = 0, Byref V_NoLinebreak As Integer = 0, Byref V_CheckAlpha As Integer = 0)
    
  804. Dim TFont As TImage Ptr = V_Font
    
  805. If TFont = 0 Then TFont = TImage_GFX_MainFont
    
  806. If TFont = 0 Then Exit Sub
    
  807. If TFont->V_Data = 0 Then TFont = TImage_GFX_MainFont
    
  808. If TFont = 0 Then Exit Sub
    
  809. If TFont->V_Data = 0 Then Exit Sub
    
  810. Dim XX As Uinteger = 0
    
  811. Dim Y As Uinteger = 0
    
  812. Dim TW As Uinteger = TFont->V_Width / 256
    
  813. Dim TH As Uinteger = TFont->V_Height
    
  814. For X As Uinteger = 1 To Len(V_Text)
    
  815.     Select Case V_Text[X - 1]
    
  816.         Case 13
    
  817.         Case 10: If V_NoLinebreak = 0 Then Y += 1: XX = 0
    
  818.         Case Else
    
  819.             XX += 1
    
  820.             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)
    
  821.     End Select
    
  822. Next
    
  823. End Sub
    
  824. 
    
  825. 
    
  826. 
    
  827. '##############################################################################################################################################################
    
  828. 'Sub TGFXInit(ByRef V_MainFontPathName as String)
    
  829. 'If TGFX_MainFont <> 0 Then TImageDestroy(TGFX_MainFont)
    
  830. 'TGFX_MainFont = TLoadImageFromFile(V_MainFontPathName)
    
  831. 'End Sub
    
  832. 
    
  833. 
    
  834. 
    
  835. '##############################################################################################################################################################
    
  836. Private Sub TImage.Cls(Byref V_Color As Uinteger = &H00000000)
    
  837. TCLS(@This, V_Color)
    
  838. End Sub
    
  839. 
    
  840. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  841. Private Sub TImage.ReplaceColor(Byref V_ColorFind As Uinteger, Byref V_ColorReplace As Uinteger)
    
  842. TReplaceColor(@This, V_ColorFind, V_ColorReplace)
    
  843. End Sub
    
  844. 
    
  845. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  846. Private Sub TImage.Pset(Byref V_X As Integer, Byref V_Y As Integer, Byref V_Color As Uinteger = &H00000000)
    
  847. TPSet(@This, V_X, V_Y, V_Color)
    
  848. End Sub
    
  849. 
    
  850. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  851. Private Function TImage.Point(Byref V_X As Integer, Byref V_Y As Integer) As Uinteger
    
  852. Return TPoint(@This, V_X, V_Y)
    
  853. End Function
    
  854. 
    
  855. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  856. 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)
    
  857. TLine(@This, V_X1, V_Y1, V_X2, V_Y2, V_Color, V_Box, V_Filled, V_LineStyle)
    
  858. End Sub
    
  859. 
    
  860. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  861. 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)
    
  862. TCircle(@This, V_X, V_Y, V_Radius, V_Color, V_Filled, V_LineStyle)
    
  863. End Sub
    
  864. 
    
  865. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  866. 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)
    
  867. TPut(@This, V_TargetX, V_TargetY, V_SourceImage, V_SourceX, V_SourceY, V_SourceW, V_SourceH, V_CopyMaskColor, V_PutColor, V_IgnorCopyMaskColor)
    
  868. End Sub
    
  869. 
    
  870. '--------------------------------------------------------------------------------------------------------------------------------------------------------------
    
  871. 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)
    
  872. TDrawString(@This, V_Font, V_Text, V_X, V_Y, V_Color, V_CharSpace, V_LineSpace, V_NoLinebreak, V_CheckAlpha)
    
  873. End Sub
    



Verwendungs-Beispiel:

  1. 'Mutex für Threadsafe
    
  2. Dim TMutex As Any Ptr = Mutexcreate()
    
  3. 
    
  4. 'TImage Bildspeicher erzeugen
    
  5. Dim TBackSurf As TImage Ptr = TImageCreate(100, 100, 32)
    
  6. 
    
  7. 'FBImage Bildspeicher erzeugen
    
  8. Dim TBlitSurf As Fb.Image Ptr = Imagecreate(100, 100, 32)
    
  9. 
    
  10. 'Operationen auf dem Bild über mehrere Thread können jetzt problemlos per mutex gesperrt werden
    
  11. Mutexlock(TMutex)
    
  12. TBackSurf->Cls(&H00FF0000)
    
  13. Mutexunlock(TMutex)
    
  14. 
    
  15. 'zum kopieren des TImage auf das FB-Image, welches nur um ""Hautpthread zu machen ist,
    
  16. 'wo auch andere GFX, MAUS, TASTA, SLEEP operationen statfinden, ebenfalls das Mutex locken
    
  17. 'und dann mit TPutToFB das TImage auf das FBImage Blitten.
    
  18. 'hierbei muss das TImage udn das FBImage die selbe grösse besitzen!!!!!!!!!
    
  19. Mutexlock(TMutex)
    
  20. TPutToFB(TBlitSurf, TBackSurf)
    
  21. Mutexunlock(TMutex)
    
  22. 
    
  23. 'Danach kann das FBImage auf den Screen Geblitet werden.
    
  24. Screenlock()
    
  25. Put (0, 0), TBlitSurf, Pset
    
  26. Screenunlock()