cs_Anthomicro
Messages postés9433Date d'inscriptionmardi 9 octobre 2001StatutMembreDernière intervention13 avril 2007
-
11 févr. 2003 à 20:12
harddisk
Messages postés54Date d'inscriptionvendredi 28 décembre 2001StatutMembreDernière intervention13 mai 2007
-
4 juin 2003 à 17:36
Bonjour,
Copiez collez le code qui suit dans un form et cliquez sur une zone du form pour voir la lenteur de la brush:
Ce code est vraiment lent, même compilé.
J'aimerais le rendre plus rapide grâce aux API GetBitmapBits et SetBitmapBits ( ou autre, cela ne me dérange pas du moment que c'est rapide) mais je n'y arrive pas ( il me dessine des ovales avec des traits plein de bugs )
Pouvez vous m'envoyer le code corrigé svp ou m'aider pour que ce code soit nettement plus rapide que GetPixel et SetPixel ?
merci d'avance
mail : jeanpierre.rossetto@club-internet.fr
***********************************************
***********************************************
***************CODE A COPIER COLLER*************
***********************************************
***********************************************
Option Explicit
'precision airbrush 2.0 PSet by dafhi
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Type AirbrushSystem
radius As Single
brush_height As Single
brush_slope As Single
height_Sq As Single
End Type
Private Type AirbrushStruct
Red As Byte
Green As Byte
Blue As Byte
Pressure As Byte
definition As Single
diameter As Single
bErasing As Boolean
Sys As AirbrushSystem
End Type
Dim Airbrush As AirbrushStruct
Dim Alpha&
Private Const B255 As Byte = 255
Dim FormActivateLoops&
Private Sub Form_Load()
ScaleMode = vbPixels
End Sub
Private Sub BlitAirbrush(Obj1 As Object, px!, py!)
Dim DrawX&
Dim DrawY&
Dim DrawLeft&
Dim DrawRight&
Dim DrawBot&
Dim DrawTop&
Dim AddDrawWidth&
Dim AddDrawHeight&
Dim ClipWidthLeft&
Dim ClipWidthBot&
Dim delta_left!
Dim delta_x!
Dim delta_y!
Dim delta_ySq!
Dim deltas_Sq_sum!
Dim BGR2&
Dim BGRed As Long
Dim BGGrn As Long
Dim BGBlu As Long
'setting up the rect that will contain the entire brush
DrawLeft = RealRound(px - Airbrush.Sys.radius)
DrawBot = RealRound(py - Airbrush.Sys.radius)
DrawRight = RealRound(px + Airbrush.Sys.radius)
DrawTop = RealRound(py + Airbrush.Sys.radius)
'Clipping
If DrawLeft < 0 Then DrawLeft = 0
If DrawBot < 0 Then DrawBot = 0
If DrawRight > SWm1 Then DrawRight = SWm1
If DrawTop > SHm1 Then DrawTop = SHm1
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
Airbrush.Red = 0
Airbrush.Green = 0
Airbrush.Blue = 0
Airbrush.definition = 1
Airbrush.diameter = 255
Airbrush.Pressure = 255
BlitAirbrush Form1, x, y
End If
End Sub
