Farliam

LockBit

Oct 13th, 2020 (edited)
34
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.     Private Sub CreateColorPallette()
  2.         canDraw_clr_Pallette = False
  3.         Dim midPoint As New Point(bmp_clr_Palette.Width / 2, bmp_clr_Palette.Height / 2)
  4.         Dim maxLength As Double = GetLinearPosDist(New Point(0, 0), midPoint)
  5.  
  6.         Dim rVal, gVal, bVal As Double
  7.         'Die Scrollbaren Max ist 100 - gleichbedeutend mit 100%
  8.  
  9.         If VScrollBar1.Value = 0 And VScrollBar2.Value = 0 And VScrollBar3.Value = 0 Then
  10.             rVal = 255
  11.             gVal = 255
  12.             bVal = 255
  13.         Else
  14.             rVal = (255 / 100) * VScrollBar1.Value
  15.             gVal = (255 / 100) * VScrollBar2.Value
  16.             bVal = (255 / 100) * VScrollBar3.Value
  17.         End If
  18.  
  19.         'Nun liegt in den rgbVal die Prozentangabe für die Farbe vor. Diese wird aufgeteilt auf die maxLength
  20.         Dim rStep As Double = rVal / maxLength
  21.         Dim gStep As Double = gVal / maxLength
  22.         Dim bStep As Double = bVal / maxLength
  23.         Dim Distance As Double
  24.  
  25.  
  26.  
  27.         'Einmal über LockBit
  28.         Dim bmp As New Bitmap(bmp_clr_Palette.Width, bmp_clr_Palette.Height, PixelFormat.Format24bppRgb)
  29.         Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  30.         Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, Drawing.Imaging.ImageLockMode.WriteOnly, bmp.PixelFormat)
  31.         Dim ptr As IntPtr = bmpData.Scan0
  32.         Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
  33.         Dim rgbValues(bytes - 1) As Byte
  34.         System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)
  35.         Dim btps As Integer = 3
  36.         Dim position As Integer = 0
  37.  
  38.         For x As Integer = 0 To bmp.Width - 1
  39.             For y As Integer = 0 To bmp.Height - 1
  40.                 position = ((y * bmp.Width * btps) + (x * btps))
  41.                 Distance = GetLinearPosDist(New Point(x, y), midPoint)
  42.                 Dim cr As Color = Color.FromArgb(Distance * rStep, Distance * gStep, Distance * bStep)
  43.                 rgbValues(position) = CByte(cr.B)
  44.                 rgbValues(position + 1) = CByte(cr.G)
  45.                 rgbValues(position + 2) = CByte(cr.R)
  46.             Next
  47.         Next
  48.  
  49.         System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, rgbValues.Length)
  50.         bmp.UnlockBits(bmpData)
  51.         bmp_clr_Palette = bmp
  52.         canDraw_clr_Pallette = True
  53.         Me.Invalidate(rct_clr_Pallette)
  54.     End Sub
RAW Paste Data