1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
| Option Explicit
'fonction API beaucoup plus rapide que Point et Step de VB
Private Declare Function SetPixel Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long) As Long
Private Declare Function GetPixel Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
Dim HSour As Integer, LSour As Integer
Dim HDest As Integer, LDest As Integer
Dim T As Integer, U As Integer
Private Sub Form_Load()
VScroll1.Move 60, 60, 255, 2955
PictResult.Move 360, 60, 345, 1245
PictSource.Move 810, 60, 1035, 255
PictSource.AutoRedraw = True
PictResult.AutoRedraw = True
PictSource.ScaleMode = vbPixels
PictResult.ScaleMode = vbPixels
Me.Height = 3465: Me.Width = 2040
End Sub
Private Sub VScroll1_Change()
PictSource.Cls: PictSource.CurrentX = 3
PictSource.Print "Z-" & CStr(Format(VScroll1.Value / 100, "00.00")) & "mm"
HSour = PictSource.ScaleHeight: LSour = PictSource.ScaleWidth
PictResult.Cls
PictResult.Height = PictSource.Width: PictResult.Width = PictSource.Height
T = 0: U = 0
Do While T <= LSour
Do While U <= HSour
SetPixel PictResult.hdc, U, T - 1, GetPixel(PictSource.hdc, LSour - T, U)
U = U + 1: DoEvents
Loop
T = T + 1: U = 0: DoEvents
Loop
PictResult.Refresh
End Sub
Private Sub VScroll1_Scroll()
VScroll1_Change
End Sub |
Partager