MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Trans]

User projects written in or related to FreeBASIC.
qbasic
Posts: 20
Joined: May 15, 2009 13:12

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by qbasic »

Thanks for your reply counting_pine.
I used your option 3 and have no problems at the present.
I will try option 2 when I get my head round what is needed.
Brains a bit slow these days.
Cheers
Bill.
creek23
Posts: 261
Joined: Sep 09, 2007 1:57
Location: Philippines
Contact:

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Tr

Post by creek23 »

I did have that crashes due to division of 0.... here's a quick fix BUT doesn't compute for the right color -- currently defaults to Black.

Code: Select all

' by D.J.Peters (Joshy)
' a put, scale, rotate hack for the new ImageHeader format.
'MultiPut [destination],[xmidpos],[ymidpos],source,[xScale],[yScale],[Mirror],[Flip],[Trans],[Custom],[Param]
' Small changes/additions by counting_pine (2007/04/27)
' Mirror and Flip parameters added by Cleber de Mattos Casali (2008/08/18)
' Alpha from D.J. Peters added by RayBritton (2008/11/07)
' Alpha Channel added by creek23 (Mj Mendoza IV) (2011/09/03)

'#define UseRad 'if not then Rotate are in degrees

Public Sub MultiPut(Byval lpTarget As Any Ptr= 0, _
						 Byval xMidPos  As Integer= 0, _
						 Byval yMidPos  As Integer= 0, _
						 Byval lpSource As Any Ptr   , _
						 Byval xScale   As Single = 1, _
						 Byval yScale   As Single = 1, _
						 Byval Rotate   As Single = 0, _
						 Byval Mirror   As Integer = 0, _
						 Byval Flipp    As Integer = 0, _
						 Byval Trans    As Integer= 0, _
						 Byval alphavalue As Integer = 255, _
						 Byval alphachannel As Integer = 1, _
						 Byval Custom As Function(Byval Src As Uinteger, Byval Dest As Uinteger, Byval Param As Any Ptr = 0) As Uinteger = 0, _
						 Byval Param As Any Ptr = 0)
	
	If (screenptr=0) Or (lpSource=0) Then Exit Sub
	
	If xScale < 0.001 Then xScale=0.001
	If yScale < 0.001 Then yScale=0.001
	
	Dim As Integer MustLock,MustRotate
	
	'variables for the alpha blending
		Dim As Uinteger srb = Any
		Dim As Uinteger drb = Any
		Dim As Uinteger  rb = Any
		Dim As Uinteger sr = Any, sg = Any, sb = Any, sa = Any, sa2 = Any
		Dim As Uinteger dr = Any, dg = Any, db = Any, da = Any, da2 = Any
		Dim As Uinteger  r = Any,  g = Any,  b = Any,  a = Any
		Dim As Uinteger sc = Any 'source (alpha) channel
	
	If lpTarget= 0 Then MustLock	=1
	If Rotate	<>0 Then MustRotate=1
	
	Dim As Integer	TargetWidth,TargetHeight,TargetBytes,TargetPitch
	If MustLock Then
		screeninfo		_
		TargetWidth , _
		TargetHeight, _
		TargetBytes ,,_
		TargetPitch
		TargetBytes Shr=3
		
		lpTarget=screenptr
	Else
		TargetBytes	= cptr(Uinteger Ptr,lpTarget)[1]
		TargetWidth	= cptr(Uinteger Ptr,lpTarget)[2]
		TargetHeight = cptr(Uinteger Ptr,lpTarget)[3]
		TargetPitch	= cptr(Uinteger Ptr,lpTarget)[4]
		lpTarget		+= 32
	End If
	If (TargetWidth<4) Or (TargetHeight<4) Then Exit Sub
	
	Dim As Integer	 SourceWidth,SourceHeight,SourceBytes,SourcePitch
	If cptr(Integer Ptr,lpSource)[0] = 7 Then
		SourceBytes	= cptr(Uinteger Ptr,lpSource)[1]
		SourceWidth	= cptr(Uinteger Ptr,lpSource)[2]
		SourceHeight = cptr(Uinteger Ptr,lpSource)[3]
		SourcePitch	= cptr(Uinteger Ptr,lpSource)[4]
		lpSource		+= 32
	Else
		SourceBytes	= cptr(Ushort Ptr,lpSource)[0] And 7
		SourceWidth	= cptr(Ushort Ptr,lpSource)[0] Shr 3
		SourceHeight = cptr(Ushort Ptr,lpSource)[1]
		SourcePitch	= SourceWidth * SourceBytes
		lpSource		+= 4
	End If
#if 0
	? TargetWidth & "x" & TargetHeight & "x" & TargetBytes,TargetPitch
	? SourceWidth & "x" & SourceHeight & "x" & SourceBytes,SourcePitch
	? MustLock,Trans
	Sleep:End
#endif
	
	If (SourceWidth<2) Or (SourceHeight<2) Then Exit Sub
	If (TargetBytes<>SourceBytes) Then Exit Sub
	
#define xs 0 'screen
#define ys 1
#define xt 2 'texture
#define yt 3
	Dim As Single Points(3,3)
	points(0,xs)=-SourceWidth/2 * xScale
	points(1,xs)= SourceWidth/2 * xScale
	points(2,xs)= points(1,xs)
	points(3,xs)= points(0,xs)
	
	points(0,ys)=-SourceHeight/2 * yScale
	points(1,ys)= points(0,ys)
	points(2,ys)= SourceHeight/2 * yScale
	points(3,ys)= points(2,ys)
	
	points(1,xt)= SourceWidth-1
	points(2,xt)= points(1,xt)
	points(2,yt)= SourceHeight-1
	points(3,yt)= points(2,yt)
	
If Mirror Then Swap points(0,xt),points(1,xt) :Swap points(2,xt),points(3,xt)
If Flipp Then Swap points(0,yt),points(3,yt) :Swap points(2,yt),points(1,yt)
'if Mirror then swap points(1,xt),points(2,xt)
'if Flipp then swap points(2,yt),points(3,yt)
	
	
	Dim As Uinteger i
	Dim As Single x,y
	If MustRotate Then
		#ifndef UseRad
		Rotate*=Atn(1)/45 'degree 2 rad
		#endif
		While Rotate< 0       :rotate+=8*Atn(1):Wend
		While Rotate>=8*Atn(1):rotate-=8*Atn(1):Wend
		For i=0 To 3
			x=points(i,xs)*Cos(Rotate) - points(i,ys)*Sin(Rotate)
			y=points(i,xs)*Sin(Rotate) + points(i,ys)*Cos(Rotate)
			points(i,xs)=x:points(i,ys)=y
		Next
	End If
	
	Dim As Integer yStart,yEnd,xStart,xEnd
	yStart=100000:yEnd=-yStart:xStart=yStart:xEnd=yEnd
	
#define LI 0   'LeftIndex
#define RI 1   'RightIndex
#define  IND 0 'Index
#define NIND 1 'NextIndex
	Dim As Integer CNS(1,1) 'Counters
	
	For i=0 To 3
		points(i,xs)=Int(points(i,xs)+xMidPos)
		points(i,ys)=Int(points(i,ys)+yMidPos)
		If points(i,ys)<yStart Then yStart=points(i,ys):CNS(LI,IND)=i
		If points(i,ys)>yEnd   Then yEnd  =points(i,ys)
		If points(i,xs)<xStart Then xStart=points(i,xs)
		If points(i,xs)>xEnd   Then xEnd  =points(i,xs)
	Next
	If yStart =yEnd         Then Exit Sub
	If yStart>=TargetHeight Then Exit Sub
	If yEnd   <0            Then Exit Sub
	If xStart = xEnd        Then Exit Sub
	If xStart>=TargetWidth  Then Exit Sub
	If xEnd   <0            Then Exit Sub
	
	Dim As Ubyte    Ptr t1,s1
	Dim As Ushort   Ptr t2,s2
	Dim As Uinteger     t2c, s2c
	Dim As Uinteger Ptr t4,s4
	
	
#define ADD 0
#define CMP 1
#define SET 2
	Dim As Integer ACS(1,2) 'add compare and set
	ACS(LI,ADD)=-1:ACS(LI,CMP)=-1:ACS(LI,SET)=3
	ACS(RI,ADD)= 1:ACS(RI,CMP)= 4:ACS(RI,SET)=0
	
	
#define EX  0
#define EU  1
#define EV  2
#define EXS 3
#define EUS 4
#define EVS 5
	Dim As Single E(2,6),S(6),Length,uSlope,vSlope
	Dim As Integer U,UV,UA,UN,V,VV,VA,VN
	
	' share the same highest point
	CNS(RI,IND)=CNS(LI,IND)
	If MustLock Then screenlock
	' loop from Top to Bottom
	While yStart<yEnd
		'Scan Left and Right sides together
		For i=LI To RI
			' bad to read but fast and short ;-)
			If yStart=points(CNS(i,IND),ys) Then
				CNS(i,NIND)=CNS(i,IND)+ACS(i,Add)
				If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
				While points(CNS(i,IND),ys) = points(CNS(i,NIND),ys)
					CNS(i, IND)=CNS(i,NIND)
					CNS(i,NIND)=CNS(i, IND)+ACS(i,Add)
					If CNS(i,NIND)=ACS(i,CMP) Then CNS(i,NIND)=ACS(i,SET)
				Wend
				E(i,EX) = points(CNS(i, IND),xs)
				E(i,EU) = points(CNS(i, IND),xt)
				E(i,EV) = points(CNS(i, IND),yt)
				Length  = points(CNS(i,NIND),ys)
				Length -= points(CNS(i, IND),ys)
				If Length <> 0.0 Then
					E(i,EXS) = points(CNS(i, NIND),xs)-E(i,EX):E(i,EXS)/=Length
					E(i,EUS) = points(CNS(i, NIND),xt)-E(i,EU):E(i,EUS)/=Length
					E(i,EVS) = points(CNS(i, NIND),yt)-E(i,EV):E(i,EVS)/=Length
				End If
				CNS(i,IND)=CNS(i,NIND)
			End If
		Next
		
		If (yStart<0)                              Then Goto SkipScanLine
		xStart=E(LI,EX)+0.5:If xStart>=TargetWidth Then Goto SkipScanLine
		xEnd  =E(RI,EX)-0.5:If xEnd < 0           Then Goto SkipScanLine
		If (xStart=xEnd)                           Then Goto SkipScanLine
		'if xEnd  <xStart                           then goto SkipScanLine
		Length=xEnd-xStart
		uSlope=E(RI,EU)-E(LI,EU):uSlope/=Length
		vSlope=E(RI,EV)-E(LI,EV):vSlope/=Length
		If xstart<0 Then
			Length=Abs(xStart)
			U=Int(E(LI,EU)+uSlope*Length)
			V=Int(E(LI,EV)+vSlope*Length)
			xStart = 0
		Else
			U=Int(E(LI,EU)):V=Int(E(LI,EV))
		End If
		If xEnd>=TargetWidth Then xEnd=TargetWidth-1
		UV=Int(uSlope):UA=(uSlope-UV)*100000:UN=0
		VV=Int(vSlope):VA=(vSlope-VV)*100000:VN=0
		xEnd-=xStart
		Select Case TargetBytes
			Case 1
				t1=cptr(Ubyte Ptr,lpTarget)
				t1+=yStart*TargetPitch+xStart:xStart=0
				If Custom Then
					While xStart<xEnd
						s1=lpSource+V*SourcePitch+U
						*t1=Custom(*s1,*t1,Param)
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t1+=1
					Wend
				Elseif Trans=0 Then
					While xStart<xEnd
						s1=lpSource+V*SourcePitch+U
						*t1=*s1
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t1+=1
					Wend
				Else
					While xStart<xEnd
						s1=lpSource+V*SourcePitch+U
						If *s1 Then *t1=*s1
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t1+=1
					Wend
				End If
			Case 2
				t2=cptr(Short Ptr,lpTarget)
				t2+=yStart*(TargetPitch Shr 1)+xStart:xStart=0
				If Custom Then
					While xStart<xEnd
						s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
						s2c=*s2
						t2c=*t2
						s2c=(s2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(s2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(s2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=(t2c And &H001F) Shl 3 Or (s2c Shr 2 And &H000007) Or _
								(t2c And &H07E0) Shl 5 Or (s2c Shr 1 And &H000300) Or _
								(t2c And &HF800) Shl 8 Or (s2c Shl 3 And &H070000) Or &HFF000000
						t2c=Custom(s2c,t2c,Param)
						*t2=(t2c Shr 3 And &H001F) Or _
								(t2c Shr 5 And &H07E0) Or _
								(t2c Shr 8 And &HF800)
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t2+=1
					Wend
				Elseif Trans=0 Then
					While xStart<xEnd
						s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
						*t2=*s2
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t2+=1
					Wend
				Else
					While xStart<xEnd
						s2=cptr(Short Ptr,lpSource)+V*(SourcePitch Shr 1)+U
						If *s2<>&HF81F Then *t2=*s2
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t2+=1
					Wend
				 End If
			Case 4
				t4=cptr(Integer Ptr,lpTarget)+yStart*(TargetPitch Shr 2)+xStart:xStart=0
				If Custom Then
					While xStart<xEnd
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						'***** start alpha blending
						'this set of if...elseif...end if conditions applies alpha blending
						'these 43 lines can be replaced with '*t4 = *s4' to remove blending
						If alphavalue = 0 Then
							'no change needed *t4 = *t4
						Elseif alphavalue = 255 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 0 Then
							*t4 = *s4
						Elseif *t4 Shr 24 = 255 Then
							srb = *s4 And &h00ff00ff
							sg	= *s4 Xor srb
							sa	= alphavalue
							
							drb = *t4 And &h00ff00ff
							dg	= *t4 Xor drb
							da	= 256 - sa
							
							rb = (drb * da + srb * sa) And &hff00ff00
							g  = (dg  * da + sg  * sa) And &h00ff0000
							
							*t4 = (rb Or g) Shr 8 Or &hff000000
						Else
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr  8) And 255
							sb = (*s4       ) And 255
							sa = (alphavalue)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr  8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						End If
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t4+=1
					Wend
				Elseif Trans=0 Then
					While xStart<xEnd
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						'***** start alpha blending
						'this set of if...elseif...end if conditions applies alpha blending
						'these 43 lines can be replaced with '*t4 = *s4' to remove blending
						If alphavalue = 0 Then
							'no change needed *t4 = *t4
						Elseif alphavalue = 255 And alphachannel = 0 Then
							*t4 = *s4
						Elseif alphavalue = 255 And alphachannel = 1 Then
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr  8) And 255
							sb = (*s4       ) And 255
							sa = (*s4 Shr 24)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr  8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							If (sa = 255) Then
								*t4 = Rgba(sr, sg, sb, sa)
							Else
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								If a > 0 Then
									r = (dr * da2 + sr * sa2) \ a
									g = (dg * da2 + sg * sa2) \ a
									b = (db * da2 + sb * sa2) \ a
									*t4 = Rgba(r, g, b, a Shr 8)
								Else
									*t4 = Rgba(dr, dg, db, da)
								EndIf
							EndIf'/'
						ElseIf alphavalue > 0 And alphachannel = 1 Then
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr  8) And 255
							sb = (*s4       ) And 255
							sc = (*s4 Shr 24) And 255
							sa = sc * (alphavalue / 255)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr  8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							If a > 0 Then
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							Else
								*t4 = Rgba(dr, dg, db, da)
							EndIf
						Elseif *t4 Shr 24 = 0 Then'/
							*t4 = *s4
						Elseif *t4 Shr 24 = 255 Then
							srb = *s4 And &h00ff00ff
							sg	= *s4 Xor srb
							sa	= alphavalue
							
							drb = *t4 And &h00ff00ff
							dg	= *t4 Xor drb
							da	= 256 - sa
							
							rb = (drb * da + srb * sa) And &hff00ff00
							g  = (dg  * da + sg  * sa) And &h00ff0000
							
							*t4 = (rb Or g) Shr 8 Or &hff000000
						Else
							sr = (*s4 Shr 16) And 255
							sg = (*s4 Shr  8) And 255
							sb = (*s4       ) And 255
							sa = (alphavalue)
							
							dr = (*t4 Shr 16) And 255
							dg = (*t4 Shr  8) And 255
							db = (*t4       ) And 255
							da = (*t4 Shr 24)
							
							sa2 = sa Shl 8
							da2 = da Shl 8 - da * sa
							a = (sa2 + da2)
							
							r = (dr * da2 + sr * sa2) \ a
							g = (dg * da2 + sg * sa2) \ a
							b = (db * da2 + sb * sa2) \ a
							*t4 = Rgba(r, g, b, a Shr 8)
						End If
						'***** end alpha blending
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t4+=1
					Wend
				Else
					While xStart<xEnd
						's4=cptr(Integer Ptr,lpSource):s4+=V*(SourcePitch shr 2):s4+=U
						s4=cptr(Integer Ptr,lpSource)+V*(SourcePitch Shr 2)+U
						If (*s4 And &HFFFFFF)<>&HFF00FF Then
							'***** start alpha blending
							'this set of if...elseif...end if conditions applies alpha blending
							'these 43 lines can be replaced with '*t4 = *s4' to remove blending
							If alphavalue = 0 Then
								'no change needed *t4 = *t4
							Elseif alphavalue = 255 And alphachannel = 0 Then
								*t4 = *s4
							Elseif alphavalue = 255 And alphachannel = 1 Then
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr  8) And 255
								sb = (*s4       ) And 255
								sa = (*s4 Shr 24)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr  8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
'								If (sa = 255) Then
'									*t4 = Rgba(sr, sg, sb, sa)
'								Else
									sa2 = sa Shl 8
									da2 = da Shl 8 - da * sa
									a = (sa2 + da2)
									If a > 0 Then
										r = (dr * da2 + sr * sa2) \ a
										g = (dg * da2 + sg * sa2) \ a
										b = (db * da2 + sb * sa2) \ a
										*t4 = Rgba(r, g, b, a Shr 8)
									Else
										*t4 = Rgba(dr, dg, db, da)
									EndIf
'								EndIf'/'
							ElseIf alphavalue > 0 And alphachannel = 1 Then
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr  8) And 255
								sb = (*s4       ) And 255
								sc = (*s4 Shr 24)
								sa = sc * (alphavalue / 255)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr  8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								If a > 0 Then
									r = (dr * da2 + sr * sa2) \ a
									g = (dg * da2 + sg * sa2) \ a
									b = (db * da2 + sb * sa2) \ a
									*t4 = Rgba(r, g, b, a Shr 8)
								Else
									*t4 = Rgba(dr, dg, db, da)
								EndIf
							Elseif *t4 Shr 24 = 0 Then'/
								*t4 = *s4
							Elseif *t4 Shr 24 = 255 Then
								srb = *s4 And &h00ff00ff
								sg	= *s4 Xor srb
								sa	= alphavalue
								
								drb = *t4 And &h00ff00ff
								dg	= *t4 Xor drb
								da	= 256 - sa
								
								rb = (drb * da + srb * sa) And &hff00ff00
								g  = (dg  * da + sg  * sa) And &h00ff0000
								
								*t4 = (rb Or g) Shr 8 Or &hff000000
							Else
								sr = (*s4 Shr 16) And 255
								sg = (*s4 Shr  8) And 255
								sb = (*s4       ) And 255
								sa = (alphavalue)
								
								dr = (*t4 Shr 16) And 255
								dg = (*t4 Shr  8) And 255
								db = (*t4       ) And 255
								da = (*t4 Shr 24)
								
								sa2 = sa Shl 8
								da2 = da Shl 8 - da * sa
								a = (sa2 + da2)
								
								r = (dr * da2 + sr * sa2) \ a
								g = (dg * da2 + sg * sa2) \ a
								b = (db * da2 + sb * sa2) \ a
								*t4 = Rgba(r, g, b, a Shr 8)
							End If
							'***** end alpha blending
						End If
						U+=UV:UN+=UA:If UN>=100000 Then U+=1:UN-=100000
						V+=VV:VN+=VA:If VN>=100000 Then V+=1:VN-=100000
						If u<0 Then u=0
						If v<0 Then v=0
						xStart+=1:t4+=1
					Wend
				End If
		End Select

SkipScanLine:
		E(LI,EX)+=E(LI,EXS):E(LI,EU)+=E(LI,EUS):E(LI,EV)+=E(LI,EVS)
		E(RI,EX)+=E(RI,EXS):E(RI,EU)+=E(RI,EUS):E(RI,EV)+=E(RI,EVS)
		yStart+=1:If yStart=TargetHeight Then yStart=yEnd 'exit loop
	Wend
	If MustLock Then screenunlock
End Sub
~creek23
N3trunn3r
Posts: 110
Joined: Feb 14, 2008 15:48

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Trans]

Post by N3trunn3r »

This does not seem to work anymore in 1.10.0 (x64 Linux):
multiput_alpha.bas(24) error 4: Duplicated definition in 'Byval Param As Any Ptr = 0)'
D.J.Peters
Posts: 8588
Joined: May 28, 2005 3:28
Contact:

Re: MultiPut[DES],[x],[y],SRC,[xScale],[yScale],[Rotate],[Trans]

Post by D.J.Peters »

Don't use this old code from "2006" use MultiPut V2.0 instead from "2016" "10 years later" also a name of a band :-)

see at: viewtopic.php?t=24479

Joshy
Post Reply