laviewpbt

It seems to be that few people use VB to create a paint programm.But in fact ,VB,especially VB 6.0 can also process image with high efficiency。We can also use pointer in vb as in c++ with a littile difference. I have made a paint programm with vb6.0 that works fast. Most effect algorithms in the sourcecode of paint.net can be easily converted to the code form of vb6.0. Here is some codes that makes the same effect with paint.net's Tile functions. Public Function Tile(Optional ByVal RotationAngle As Long = 30, Optional ByVal SquareSize As Long = 40, Optional ByVal Curvature As Long = 10, Optional ByVal Quality As Long = 2) As Boolean Dim i As Long, j As Long Dim k As Long, Red As Long Dim Blue As Long, Green As Long Dim x As Long, y As Long Dim HalfWidth As Double, HalfHeight As Double Dim SinValue As Double, CosValue As Double Dim ScaleFactor As Double, Intensity As Double Dim s As Double, T As Double Dim TempX As Double, TempY As Double Dim Width As Long, Height As Long Dim U As Double, V As Double Dim xSample As Long, ySample As Long Dim Samples As Long, Temp As Long Dim DataArr(0 To 2) As Byte, pDataArr(0 To 0) As Long Dim OldArrPtr As Long, OldpArrPtr As Long Dim LineAddBytes As Long, PixelAddBytes As Long Dim DataArrC(0 To 2) As Byte, pDataArrC(0 To 0) As Long Dim OldArrPtrC As Long, OldpArrPtrC As Long Dim mPtrC As Long, m As Long Dim PixelNumber As Long, DealedPixel As Long If mImageMode <> RGBMode And mImageMode <> GreyMode Or mHdc = 0 Then RaiseEvent ErrorOccur("Cannot Processing it.") Exit Function End If RaiseEvent ProgressStart(InnerCall, 0) If RotationAngle < -180 Then RotationAngle = -180 If RotationAngle > 180 Then RotationAngle = 180 If SquareSize < 1 Then SquareSize = 1 If SquareSize > 800 Then SquareSize = 800 If Curvature < -100 Then Curvature = -100 If Curvature > 100 Then Curvature = 100 If Quality < 1 Then Quality = 1 If Quality > 5 Then Quality = 5 Width = Me.Width Height = Me.Height HalfWidth = Width / 2 HalfHeight = Height / 2 SinValue = Sin(RotationAngle * 3.1415926 / 180) CosValue = Cos(RotationAngle * 3.1415926 / 180) ScaleFactor = 3.1415926 / SquareSize Intensity = Curvature * Curvature / 10 * Sgn(Curvature) Samples = Quality * Quality + 1 ReDim Points(Samples - 1) As PointF For i = 0 To Samples - 1 TempX = (i * Quality) / Samples TempY = i / Samples TempX = TempX - CInt(TempX) Points(i).x = CosValue * TempX + SinValue * TempY Points(i).y = CosValue * TempY - SinValue * TempX Next For k = 0 To UBound(DealRect) PixelNumber = PixelNumber + (DealRect(k).Right - DealRect(k).Left + 1) * (DealRect(k).Bottom - DealRect(k).Top + 1) Next PixelAddBytes = mBmpInfo.biBitCount / 8 MakePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr MakePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrPtrC mPtrC = GlobalAlloc(GPTR, mBmpInfo.biSizeImage) SuperCopyMemory ByVal mPtrC, ByVal mPtr, mBmpInfo.biSizeImage If mImageMode = RGBMode And mDealChannel = R_G_B Then For k = 0 To UBound(DealRect) pDataArr(0) = mPtr + mWidthBytes * DealRect(k).Top + DealRect(k).Left * PixelAddBytes LineAddBytes = mWidthBytes - (DealRect(k).Right - DealRect(k).Left + 1) * PixelAddBytes For j = DealRect(k).Top To DealRect(k).Bottom y = j - HalfHeight For i = DealRect(k).Left To DealRect(k).Right Blue = 0 Green = 0 Red = 0 x = i - HalfWidth For m = 0 To Samples - 1 U = x + Points(m).x V = y - Points(m).y s = CosValue * U + SinValue * V T = -SinValue * U + CosValue * V s = s + Intensity * Tan(s * ScaleFactor) T = T + Intensity * Tan(T * ScaleFactor) U = CosValue * s - SinValue * T V = SinValue * s + CosValue * T xSample = HalfWidth + U ySample = HalfHeight + V xSample = (xSample + Width) Mod Width If xSample < 0 Then xSample = (xSample + Width) Mod Width End If ySample = (ySample + Height) Mod Height If ySample < 0 Then ySample = (ySample + Height) Mod Height End If pDataArrC(0) = mPtrC + ySample * mWidthBytes + xSample * PixelAddBytes Blue = Blue + DataArrC(0) Green = Green + DataArrC(1) Red = Red + DataArrC(2) Next DataArr(2) = Red \ Samples DataArr(1) = Green \ Samples DataArr(0) = Blue \ Samples pDataArr(0) = pDataArr(0) + PixelAddBytes If i Mod 200 = 0 Then DoEvents Next DealedPixel = DealedPixel + (DealRect(k).Right - DealRect(k).Left + 1) pDataArr(0) = pDataArr(0) + LineAddBytes If j Mod 20 = 0 Then RaiseEvent Progressing(DealedPixel * 100 \ PixelNumber) Next Next End If GlobalFree mPtrC FreePoint VarPtrArray(DataArr), VarPtrArray(pDataArr), OldArrPtr, OldpArrPtr FreePoint VarPtrArray(DataArrC), VarPtrArray(pDataArrC), OldArrPtrC, OldpArrPtrC RaiseEvent ProgressEnd(InnerCall, 0) Tile = True End Function So with the update of paint.net,1 will update my paint software at the same time .I really appreciate your great work. Sorry about my poor english.