Farliam

bmp SetPixel

Oct 13th, 2020 (edited)
13
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.         'Einmal über SetPixel
  26.         Dim bmp As New Bitmap(bmp_clr_Palette.Width, bmp_clr_Palette.Height, PixelFormat.Format24bppRgb)
  27.  
  28.         For x As Integer = 0 To bmp.Width - 1
  29.             For y As Integer = 0 To bmp.Height - 1
  30.                 Distance = GetLinearPosDist(New Point(x, y), midPoint)
  31.                 Dim cr As Color = Color.FromArgb(Distance * rStep, Distance * gStep, Distance * bStep)
  32.                 bmp.SetPixel(x, y, cr)
  33.             Next
  34.         Next
  35.         bmp_clr_Palette = bmp
  36.         canDraw_clr_Pallette = True
  37.         Me.Invalidate(rct_clr_Pallette)
  38.     End Sub
RAW Paste Data