.. .. .. ..   ..
BlitzBasic > Codearchiv > GrafikAktuallisiert 30.05.2009

..  Alphaplot und Alpharect - von Rob 
Punkte und Rechtecke mit Alphakanal (Transparenz) malen. Mit Beispielprogramm.

x,y: Koordinaten
r,g,b: rgb-Farbcode
alpha: Transparenz (0-100, nicht sichtbar bis voll überdeckend)

Graphics 640,480,32,2 
  SetBuffer BackBuffer() 

  Image = LoadImage("Test.png") 
  Dim Buffer(ImageWidth(Image),ImageHeight(Image)) 
  Dim Picture(ImageWidth(Image),ImageHeight(Image)) 

  SetBuffer ImageBuffer(Image) 
  LockBuffer ImageBuffer(Image) 

  For X = 0 To ImageWidth(Image) 
     For Y = 0 To ImageHeight(Image) 
          Buffer(X,Y) = ReadPixelFast(X,Y) 
     Next 
  Next 

  For X = 0 To ImageWidth(Image) - 3 
     For Y = 0 To ImageHeight(Image) 
     BufferR1 = GetR(Buffer(X,Y)) 
     BufferG1 = GetG(Buffer(X,Y)) 
     BufferB1 = GetB(Buffer(X,Y)) 

     BufferR2 = GetR(Buffer(X + 3,Y)) 
     BufferG2 = GetG(Buffer(X + 3,Y)) 
     BufferB2 = GetB(Buffer(X + 3,Y)) 

     TempR = BufferR1 + 0.5 * (BufferR1 - BufferR2) 
     If TempR > 255 Then TempR = 255 
     If TempR < 0 Then TempR = 0 

     TempG = BufferG1 + 0.5 * (BufferG1 - BufferG2) 
     If TempG > 255 Then TempG = 255 
     If TempG < 0 Then TempG = 0 

     TempB = BufferB1 + 0.5 * (BufferB1 - BufferB2) 
     If TempB > 255 Then TempB = 255 
     If TempB < 0 Then TempB = 0 

     Picture(X,Y) = GetRGB(TempR,TempG,TempB) 
     Next 
  Next 

  For X = 0 To ImageWidth(Image) - 3 
     For Y = 0 To ImageHeight(Image) 
          WritePixelFast X,Y,Picture(X,Y) 
     Next 
  Next 

  For X = ImageWidth(Image) - 3 To ImageWidth(Image) 
     For Y = ImageHeight(Image) To ImageHeight(Image) 
        WritePixelFast X,Y,Buffer(X,Y) 
     Next 
  Next 
  UnlockBuffer ImageBuffer(Image) 


  Dim Buffer(0,0) 
  Dim Picture(0,0) 

  SetBuffer BackBuffer() 
  DrawImage Image,0,0 : Flip 

  WaitKey : FreeImage Image : End 


  Function GetR(RGB) 
      Return (RGB And $FF0000) / $10000 
  End Function 

  Function GetG(RGB) 
      Return (RGB And $FF00) / $100 
  End Function 

  Function GetB(RGB) 
      Return RGB And $FF 
  End Function 

  Function GetRGB(R,G,B) 
      Return R * $10000 + G * $100 + B 
  End Function