03-05-2025, 04:39 AM
tranny kpop matrix mod
Code: (Select All)
deflng a-z
'Option _Explicit bubu
'$Console
$VersionInfo:Comments=Avicap32 webcam to memory test
'Using $VersionInfo so we get modern controls
'------------------------------------------------------------------------------------------------------------------------------
'Capture Driver Constants
Const WM_CAP_START = &H0400
Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
Const WM_CAP_SET_SCALE = WM_CAP_START + 53
Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61
Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
Const CF_DIB = &H0008
Const PM_REMOVE = &H0001
Const WS_EX_NOACTIVATE = &H08000000
Const FPS = 60 'Not recommended to set this higher than frame rate of webcam/video device
Const VIDWIDTH = 640
Const VIDHEIGHT = 480
type ptype
c as string * 1
d as long
img as long
end type
n = 126-32
dim p(n) as ptype
dim z as _unsigned long
Type BITMAPINFOHEADER
As _Unsigned Long biSize
As Long biWidth, biHeight
As _Unsigned Integer biPlanes, biBitCount
As _Unsigned Long biCompression, biSizeImage
As Long biXPelsPerMeter, biYPelsPerMeter
As _Unsigned Long biClrUsed, biClrImportant
End Type
Type BITMAPINFO
As BITMAPINFOHEADER bmiHeader
End Type
Type POINT
As Long x, y
End Type
Type MSG
As _Offset hwnd
As _Unsigned Long message
$If 64BIT Then
As String * 4 padding1
$End If
As _Unsigned _Offset wParam
As _Offset lParam
As _Unsigned Long time
$If 64BIT Then
As String * 4 padding2
$End If
As POINT pt
As _Unsigned Long lPrivat
End Type
Declare Dynamic Library "Avicap32"
Function CreateCaptureWindow& Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As _Offset, ByVal dwStyle As _Unsigned Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hwndParent As _Offset, ByVal nId As Long)
End Declare
Declare CustomType Library
Sub SendMessage Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
Function SendMessage& Alias "SendMessageA" (ByVal hWnd As _Offset, ByVal Msg As _Unsigned Long, ByVal wParam As _Offset, ByVal lParam As _Offset)
Function PeekMessage& Alias "PeekMessageA" (ByVal lpMsg As _Offset, ByVal hWnd As _Offset, ByVal wMsgFilterMin As _Unsigned Long, ByVal wMsgFilterMax As _Unsigned Long, ByVal wRemoveMsg As _Unsigned Long)
Sub TranslateMessage (ByVal lpMsg As _Offset)
Sub DispatchMessage (ByVal lpMsg As _Offset)
Sub DestroyWindow (ByVal hWnd As _Offset)
Function mmioStringToFOURCC& (sz As String, ByVal uFlags As _Unsigned Long)
Function OpenClipboard& (ByVal hWndNewOwner As _Offset)
Function GetClipboardData%& (ByVal uFormat As _Unsigned Long)
Sub CloseClipboard ()
Function GlobalLock%& (ByVal hMem As _Offset)
Function GlobalUnlock& (ByVal hMem As _Offset)
Function LoadLibrary%& (lpLibFileName As String)
Function GetProcAddress%& (ByVal hModule As _Offset, lpProcName As String)
End Declare
Declare Library ".\internal\c\c_compiler\include\vfw"
End Declare
Declare Library "framecallback"
End Declare
Dim Shared As Single SATURATION_LEVEL: SATURATION_LEVEL = 1.00 '0.00 for greyscale, 1.00 for normal, and >1.00 for oversaturation
Dim Shared As Single BRIGHTNESS_LEVEL: BRIGHTNESS_LEVEL = 1.00
Dim Shared As _Byte NEGATIVE: NEGATIVE = _FALSE
Dim Shared As _Byte FLIPPED_H: FLIPPED_H = _FALSE
Dim Shared As _Byte FLIPPED_V: FLIPPED_V = _FALSE
Dim Shared As Single COLOR_TEMP_WARM: COLOR_TEMP_WARM = 1.00
Dim Shared As Single COLOR_TEMP_COOL: COLOR_TEMP_COOL = 1.00
Dim Shared As Single COLOR_GREEN: COLOR_GREEN = 1.00
Dim Shared As _Unsigned _Byte PALETTE_SWAP: PALETTE_SWAP = 0
Dim Shared As _Byte EVERY_OTHER_H: EVERY_OTHER_H = _FALSE
Dim Shared As _Byte EVERY_OTHER_V: EVERY_OTHER_V = _FALSE
Dim Shared As _Byte GHOST: GHOST = _FALSE
Screen _NewImage(VIDWIDTH, VIDHEIGHT, 32)
_Delay 0.2 'Just in case
''''''''''''
for i=0 to n
p(i).img = _newimage(8, 16, 32)
_dest p(i).img
_source p(i).img
_printstring (0,0), chr$(i + 32)
p(i).c = chr$(i + 32)
sum = 0
for y=0 to 16-1
for x=0 to 8-1
z = point(x, y)
'pset (x, y), z
if point(x,y)=_rgb(255,255,255) then sum = sum + 1
next
next
p(i).d = sum
next
for i=1 to ubound(p)
j = i
do while (j>0 and p(j-1).d > p(j).d)
swap p(j), p(j-1)
j = j - 1
loop
next
_dest 0
_source 0
'''''''''''''
_ScreenMove (_DesktopWidth / 2) - VIDWIDTH / 2, (_DesktopHeight / 2) - VIDHEIGHT / 2
Dim As String captureWinText: captureWinText = "Webcam API Test - Child" + Chr$(0)
Dim As _Offset childID
Dim As _Offset childWin: childWin = CreateCaptureWindow(_Offset(captureWinText), WS_EX_NOACTIVATE, 0, 0, VIDWIDTH, VIDHEIGHT, _WindowHandle, childID)
If childWin = 0 Then
Print "Couldn't create capture window."
End
End If
_Title "Webcam API Test - Parent"
SetupDriver childWin, _TRUE 'change _FALSE to _TRUE to use default settings
Print "Previewing... Press Space bar to stop"
Print "Press escape to kill the window"
Dim As _Integer64 k
Dim As MSG msg
'Dim As Long i
Dim Shared As _MEM frame
'$Checking:Off
Do
k = _KeyHit
If PeekMessage(_Offset(msg), 0, 0, 0, PM_REMOVE) Then
TranslateMessage _Offset(msg)
DispatchMessage _Offset(msg)
Else
GrabFrame childWin
End If
'Screen frame.IMAGE
w = _width(0)
h = _height(0)
_source 0
for y=0 to h/16 - 1
for x=0 to w/8 - 1
'0.299r + 0.587g + 0.114b
z = point(x*8 + 4, y*16 + 8)
'z2 = point(x*8 + 4, y*16 + 4)
r = _red(z)
g = _blue(z)
b = _green(z)
c = 0.299*r + 0.587*g + 0.114*b
c = (c/255)*n
'circle (x*8 + 4, y*16 + 8), 3, z
color z ', z2
'if c > 1*n/4 then
_printstring (x*8, y*16), p(c).c
'end if
next
next
_Display
Select Case k
Case 32 'Space bar
Exit Do
Case 27 'Escape - Reset
BRIGHTNESS_LEVEL = 1.00
SATURATION_LEVEL = 1.00
NEGATIVE = _FALSE
FLIPPED_H = _FALSE
FLIPPED_V = _FALSE
COLOR_TEMP_WARM = 1.00
COLOR_TEMP_COOL = 1.00
COLOR_GREEN = 1.00
PALETTE_SWAP = 0
EVERY_OTHER_H = _FALSE
EVERY_OTHER_V = _FALSE
GHOST = _FALSE
Cls
Case 43 'numpad plus key
If SATURATION_LEVEL < 2.00 Then
SATURATION_LEVEL = SATURATION_LEVEL + .10
End If
Case 45 'numpad minus key
If SATURATION_LEVEL > 0.00 Then
SATURATION_LEVEL = SATURATION_LEVEL - .10
End If
Case 18432 'arrow key up
If BRIGHTNESS_LEVEL < 2 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL + .10
End If
Case 20480 'arrow key down
If BRIGHTNESS_LEVEL > 0.00 Then
BRIGHTNESS_LEVEL = BRIGHTNESS_LEVEL - .10
End If
Case Asc("N"), Asc("n") 'negative filter toggle
NEGATIVE = Not NEGATIVE
Case Asc("P"), Asc("p")
If _FileExists("capture(" + _ToStr$(i) + ").png") Then
While _FileExists("capture(" + _ToStr$(i) + ").png")
i = i + 1
Wend
End If
_SaveImage "capture(" + _ToStr$(i) + ").png", _Display, "PNG"
i = i + 1
Case Asc("C"), Asc("c")
_ClipboardImage = _Display
Case Asc("H"), Asc("h")
FLIPPED_H = Not FLIPPED_H
Case Asc("V"), Asc("v")
FLIPPED_V = Not FLIPPED_V
Case Asc("R")
If COLOR_TEMP_WARM < 2.00 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM + .10
End If
Case Asc("r")
If COLOR_TEMP_WARM > 0 Then
COLOR_TEMP_WARM = COLOR_TEMP_WARM - .10
End If
Case Asc("G")
If COLOR_GREEN < 2.00 Then
COLOR_GREEN = COLOR_GREEN + .10
End If
Case Asc("g")
If COLOR_GREEN > 0 Then
COLOR_GREEN = COLOR_GREEN - .10
End If
Case Asc("B")
If COLOR_TEMP_COOL < 2.00 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL + .10
End If
Case Asc("b")
If COLOR_TEMP_COOL > 0 Then
COLOR_TEMP_COOL = COLOR_TEMP_COOL - .10
End If
Case Asc("1")
PALETTE_SWAP = 1
Case Asc("2")
PALETTE_SWAP = 2
Case Asc("3")
PALETTE_SWAP = 3
Case Asc("4")
PALETTE_SWAP = 4
Case Asc("5")
PALETTE_SWAP = 5
Case Asc("6")
PALETTE_SWAP = 6
Case Asc("Z"), Asc("z")
SendMessage childWin, WM_CAP_DLG_VIDEOSOURCE, 0, 0
Case Asc("\")
EVERY_OTHER_V = Not EVERY_OTHER_V
Cls
Case Asc("/")
EVERY_OTHER_H = Not EVERY_OTHER_H
Cls
Case Asc(";")
EVERY_OTHER_V = _TRUE
EVERY_OTHER_H = _TRUE
Case Asc("T"), Asc("t")
GHOST = Not GHOST
End Select
_Limit FPS
Loop
'$Checking:On
Print "Disconnecting Driver"
KillDriver childWin
Sub SetupDriver (hwnd As _Offset, defaultSource As _Byte)
Dim As _Offset libload: libload = LoadLibrary(Command$(0))
Dim As _Offset myCallback: myCallback = GetProcAddress(libload, "CapVideoCallback")
If myCallback = 0 Then
Print "Can't find callback pointer"
End
End If
Dim As BITMAPINFO format
SendMessage hwnd, WM_CAP_DRIVER_CONNECT, 0, 0
SendMessage hwnd, WM_CAP_SET_SCALE, _FALSE, 0
SendMessage hwnd, WM_CAP_SET_PREVIEW, _FALSE, 0
Dim As _Unsigned Long formatSize: formatSize = SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
If Len(format) <> formatSize Then
KillDriver hwnd
Print "Wrong size"
Print formatSize, Len(format)
End
End If
If SendMessage(hwnd, WM_CAP_GET_VIDEOFORMAT, Len(format), _Offset(format)) = 0 Then
KillDriver hwnd
Print "Couldn't get format"
End
End If
format.bmiHeader.biSize = Len(format)
format.bmiHeader.biWidth = VIDWIDTH
format.bmiHeader.biHeight = VIDHEIGHT
format.bmiHeader.biPlanes = 1
format.bmiHeader.biBitCount = 16 'yuy2 format
format.bmiHeader.biSizeImage = VIDWIDTH * VIDHEIGHT * 2
format.bmiHeader.biCompression = mmioStringToFOURCC("YUY2" + Chr$(0), &H00000010) 'MUST BE YUY2 FORMAT
If SendMessage(hwnd, WM_CAP_SET_VIDEOFORMAT, Len(format), _Offset(format)) = 0 Then
KillDriver hwnd
Print "Failed to set video format"
End
End If
If defaultSource = _FALSE Then
SendMessage hwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0 'PICK YUY2!!!
SendMessage hwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0
End If
SendMessage hwnd, WM_CAP_GET_VIDEOFORMAT, 0, _Offset(format)
SendMessage hwnd, WM_CAP_SET_CALLBACK_FRAME, 0, myCallback
End Sub
Sub KillDriver (hwnd As _Offset)
SendMessage hwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
DestroyWindow hwnd
End Sub
Sub GrabFrame (hwnd As _Offset)
SendMessage hwnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End Sub
Function CapVideoCallback%& (hWnd As _Offset, lpVHdr As _Offset)
Type VIDEOHDR
As _Offset lpData
As _Unsigned Long dwBufferLength, dwBytesUsed, dwTimeCaptured
As String * 4 padding1
As _Unsigned _Offset dwUser
As _Unsigned Long dwFlags
As String * 4 padding2
As _Offset dwReserved1, dwReserved2, dwReserved3, dwReserved4
End Type
Dim As VIDEOHDR vhdr
Dim As _MEM pVhdr: pVhdr = _Mem(lpVHdr, Len(vhdr))
_MemGet pVhdr, pVhdr.OFFSET, vhdr
_MemFree pVhdr
Dim As _Unsigned Long frameSize: frameSize = SendMessage(hWnd, WM_CAP_GET_VIDEOFORMAT, 0, 0)
If frameSize = 0 Then
Print "Failed to get video format size"
'KillDriver hWnd
'End
End If
Dim As BITMAPINFO bi
SendMessage hWnd, WM_CAP_GET_VIDEOFORMAT, frameSize, _Offset(bi)
'Print bi.bmiHeader.biHeight
Dim As _MEM lpData: lpData = _Mem(vhdr.lpData, vhdr.dwBufferLength)
Dim As Long bitsPerPixel: bitsPerPixel = bi.bmiHeader.biBitCount
Dim As Long bytesPerPixel: bytesPerPixel = (bitsPerPixel + 7) \ 8
Dim As _Unsigned Long stride: stride = (((bi.bmiHeader.biWidth * bi.bmiHeader.biBitCount) + 31) And Not 31) \ 8
Dim As Long y, x
Dim As _Unsigned _Byte yuy2(0 To 3)
Dim As _Offset pScanLine
Dim As _Unsigned _Integer64 converted
Dim As _Unsigned _Byte r, g, b
Dim As _Offset pixelOffset
If _MemExists(frame) Then _MemFree frame
'Dim As Long i: i = _NewImage(bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 32)
frame = _MemImage(0)
Dim As _Offset o: o = frame.OFFSET
For y = 0 To bi.bmiHeader.biHeight - 1
If o >= frame.OFFSET + frame.SIZE Then Exit For
pScanLine = lpData.OFFSET + (y * stride)
For x = 0 To bi.bmiHeader.biWidth - bytesPerPixel Step bytesPerPixel
pixelOffset = pScanLine + (x * bytesPerPixel)
_MemGet lpData, pixelOffset, yuy2()
converted = ConvertYUY2toRGB(yuy2())
_MemPut frame, o, _Blue32(converted) As _UNSIGNED _BYTE
_MemPut frame, o + 1, _Green32(converted) As _UNSIGNED _BYTE
_MemPut frame, o + 2, _Red32(converted) As _UNSIGNED _BYTE
'PSet (x, y), converted And &HFFFFFFFF
o = o + bytesPerPixel + 2
If Not EVERY_OTHER_V Then
'PSet (x + 1, y), _ShR(converted, 32) And &HFFFFFFFF
_MemPut frame, o, _Blue32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
_MemPut frame, o + 1, _Green32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
_MemPut frame, o + 2, _Red32(_ShR(converted, 32) And &HFFFFFFFF) As _UNSIGNED _BYTE
o = o + bytesPerPixel + 2
Else
o = o + 4
End If
Next
Next
'If FLIPPED_H Then
' Dim As Long hi: hi = _CopyImage(i)
' _PutImage , hi, i, (bi.bmiHeader.biWidth - 1, 0)-(0, bi.bmiHeader.biHeight - 1)
' _FreeImage hi
'End If
'If FLIPPED_V Then
' Dim As Long vi: vi = _CopyImage(i)
' _PutImage , vi, i, (bi.bmiHeader.biWidth - 1, bi.bmiHeader.biHeight - 1)-(0, 0)
' _FreeImage vi
'End If
End Function
Function ConvertYUY2toRGB~&& (yuy2() As _Unsigned _Byte)
Dim As _Unsigned _Byte r1, g1, b1, r2, g2, b2, r3, g3, b3
Dim As Double Y1, Y2, U, V
' Extract values
Y1 = yuy2(0) * BRIGHTNESS_LEVEL
Y2 = yuy2(2) * BRIGHTNESS_LEVEL
U = (yuy2(1) - 128) * SATURATION_LEVEL
V = (yuy2(3) - 128) * SATURATION_LEVEL
' Convert first pixel
r1 = _Clamp((Y1 + 1.13983 * V) * COLOR_TEMP_WARM, 0, 255)
g1 = _Clamp((Y1 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b1 = _Clamp((Y1 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
' Convert second pixel
r2 = _Clamp((Y2 + 1.13983 * V) * COLOR_TEMP_WARM, 0, 255)
g2 = _Clamp((Y2 - 0.39465 * U - 0.58060 * V) * COLOR_GREEN, 0, 255)
b2 = _Clamp((Y2 + 2.03211 * U) * COLOR_TEMP_COOL, 0, 255)
If NEGATIVE Then
r1 = 255 - r1: g1 = 255 - g1: b1 = 255 - b1
r2 = 255 - r2: g2 = 255 - g2: b2 = 255 - b2
End If
If PALETTE_SWAP > 0 Then
Select Case PALETTE_SWAP
Case 1
''Dobra
r3 = _Clamp(r1 * 0.989 + g1 * 1.000 + b1 * 0.510, 0, 255)
g3 = _Clamp(r1 * 0.157 + g1 * 0.500 + b1 * 0.400, 0, 255)
b3 = _Clamp(r1 * 0.278 + g1 * 0.000 + b1 * 0.267, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.989 + g2 * 1.000 + b2 * 0.510, 0, 255)
g3 = _Clamp(r2 * 0.157 + g2 * 0.500 + b2 * 0.400, 0, 255)
b3 = _Clamp(r2 * 0.278 + g2 * 0.000 + b2 * 0.267, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 2
''Roden
r3 = _Clamp(r1 * 0.545 + g1 * 0.0902 + b1 * 0.804, 0, 255)
g3 = _Clamp(r1 * 0.412 + g1 * 0.502 + b1 * 0.522, 0, 255)
b3 = _Clamp(r1 * 0.412 + g1 * 0.427 + b1 * 0.247, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.545 + g2 * 0.0902 + b2 * 0.804, 0, 255)
g3 = _Clamp(r2 * 0.412 + g2 * 0.502 + b2 * 0.522, 0, 255)
b3 = _Clamp(r2 * 0.412 + g2 * 0.427 + b2 * 0.247, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 3
''Flowers
r3 = _Clamp(r1 * 0.753 + g1 * 1.000 + b1 * 0.000, 0, 255)
g3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 0.000, 0, 255)
b3 = _Clamp(r1 * 0.000 + g1 * 1.000 + b1 * 1.000, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0.753 + g2 * 1.000 + b2 * 0.000, 0, 255)
g3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 0.000, 0, 255)
b3 = _Clamp(r2 * 0.000 + g2 * 1.000 + b2 * 1.000, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 4
''GBR
r3 = _Clamp(r1 * 0 + g1 * 0 + b1 * 1, 0, 255)
g3 = _Clamp(r1 * 1 + g1 * 0 + b1 * 0, 0, 255)
b3 = _Clamp(r1 * 0 + g1 * 1 + b1 * 0, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp(r2 * 0 + g2 * 0 + b2 * 1, 0, 255)
g3 = _Clamp(r2 * 1 + g2 * 0 + b2 * 0, 0, 255)
b3 = _Clamp(r2 * 0 + g2 * 1 + b2 * 0, 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 5
''Sepia
r3 = _Clamp((r1 * 0.393) + (g1 * 0.769) + (b1 * 0.189), 0, 255)
g3 = _Clamp((r1 * 0.349) + (g1 * 0.686) + (b1 * 0.168), 0, 255)
b3 = _Clamp((r1 * 0.272) + (g1 * 0.534) + (b1 * 0.131), 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 * 0.393) + (g2 * 0.769) + (b2 * 0.189), 0, 255)
g3 = _Clamp((r2 * 0.349) + (g2 * 0.686) + (b2 * 0.168), 0, 255)
b3 = _Clamp((r2 * 0.272) + (g2 * 0.534) + (b2 * 0.131), 0, 255)
r2 = r3
g2 = g3
b2 = b3
Case 6
''High contrast
r3 = _Clamp((r1 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g1 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b1 - 128) * 1.5 + 128, 0, 255)
r1 = r3
g1 = g3
b1 = b3
r3 = _Clamp((r2 - 128) * 1.5 + 128, 0, 255)
g3 = _Clamp((g2 - 128) * 1.5 + 128, 0, 255)
b3 = _Clamp((b2 - 128) * 1.5 + 128, 0, 255)
r2 = r3
g2 = g3
b2 = b3
End Select
End If
' Pack pixels into a single return value
If GHOST Then
ConvertYUY2toRGB = _RGBA32(r1, g1, b1, 175) Or _ShL(_RGBA32(r2, g2, b2, 175), 32)
Else
ConvertYUY2toRGB = _RGB32(r1, g1, b1) Or _ShL(_RGB32(r2, g2, b2), 32)
End If
End Function