#Include once "window9.bi"

'Dim Shared AlphaBlend as function( byval hdcDest as HDC, _
'byval nXOriginDest as integer, _
'byval nYOriginDest as integer, _
'byval nWidthDest as integer, _
'byval nHeightDest as integer, _
'byval hdcSrc as HDC, _
'byval nXOriginSrc as integer, _
'byval nYOriginSrc as integer, _
'byval nWidthSrc as integer, _
'byval nHeightSrc as integer, _
'byval blendFunction as BLENDFUNCTION ) as BOOL
'
'Dim Shared GradientFill as function( byval hdc as HDC, _
'byval pVertex as PTRIVERTEX, _
'byval dwNumVertex as ULONG, _
'byval pMesh as PVOID, _
'byval dwNumMesh as ULONG, _
'byval dwMode as ULONG ) as BOOL
'
'Dim shared TransparentBlt as function( byval hdcDest as HDC, _
'byval nXOriginDest as integer, _
'byval nYOriginDest as integer, _
'byval nWidthDest as integer, _
'byval nHeightDest as integer, _
'byval hdcSrc as HDC, _
'byval nXOriginSrc as integer, _
'byval nYOriginSrc as integer, _
'byval nWidthSrc as integer, _
'byval nHeightSrc as integer, _
'byval crTransparent as UINT ) as BOOL
'
'dim as any pointer hLib
'
'hLib = Dylibload( "msimg32.dll" )
'if hLib = null then
'	print "Dylibload failed"
'	sleep
'	end
'endif
'
'AlphaBlend = Dylibsymbol( hLib, "AlphaBlend" )
'if AlphaBlend = null then
'	print "Dylibsymbol(AlphaBlend) failed"
'	sleep
'	Dylibfree( hLib )
'	end
'endif
'
'GradientFill = Dylibsymbol( hLib, "GradientFill" )
'if GradientFill = null then
'	print "Dylibsymbol(GradientFill) failed"
'	sleep
'	Dylibfree( hLib )
'	end
'endif
'
'TransparentBlt = Dylibsymbol( hLib, "TransparentBlt" )
'if TransparentBlt = null then
'	print "Dylibsymbol(TransparentBlt) failed"
'	sleep
'	Dylibfree( hLib )
'	end
'EndIf

Dim Shared As HWND wind___
Dim Shared As HFONT RezerveFont_
Dim Shared As integer H_BIT_FLAG,H_Alpha_FLAG,H_ALPHA_VALUE
Dim Shared As HDC MemDC,MainDC
Dim Shared As HBITMAP hbitmapMaindraw
Dim Shared Window9RectPos As RECT
Type Point_
	As Integer x
	As Integer y
End Type
sub SETDCPrint(pHdc As HDC) Export
	MemDC=pHdc
End sub

Function ImageStartDraw(ByVal hbitmap As hbitmap) As HDC Export
	H_BIT_FLAG=1
	MemDC = Cast(HDC,CreateCompatibleDC(0))
	hbitmapMaindraw=hbitmap
	SelectObject(Cast(HDC,MemDC),Cast(hbitmap,hbitmapMaindraw))
	Return MemDC
End Function

Function WindowStartDraw(ByVal window_ As HWND,ByVal x As Integer=0,ByVal y As Integer=0,ByVal width_ As Integer=0, ByVal height_ As Integer=0,ByVal Alpha_FLAG As Integer=0, ByVal Alpha_VALUE As UInteger=0) As HDC Export
	H_BIT_FLAG=0:H_Alpha_FLAG=Alpha_FLAG:H_Alpha_VALUE=Alpha_VALUE
	If width_ =0 Then width_ = WindowClientWidth(window_)
	If height_=0 Then height_= WindowClientHeight(window_)
	Window9RectPos.left   = x
	Window9RectPos.top    = y
	Window9RectPos.right  = width_
	Window9RectPos.bottom = height_
	wind___ = window_
	If wind___ = GetDesktopWindow Then
		MainDC  = GetWindowDC(window_)
	Else
		MainDC  = GetDC(window_)
	EndIf
	MemDC   = CreateCompatibleDC(Maindc)
	hbitmapMaindraw = CreateCompatibleBitmap(Maindc,width_,height_)
	SelectObject(MemDC,hbitmapMaindraw)
	Return MemDC
End Function

Function StopDraw() As Integer Export
	If H_BIT_FLAG=0 Then
		If H_Alpha_FLAG=0 Then
			BitBlt(Maindc,Window9RectPos.left,Window9RectPos.top,Window9RectPos.right,Window9RectPos.bottom,Memdc,0,0,SRCCOPY)
		Else
			TransparentBlt(Maindc,Window9RectPos.left,Window9RectPos.top,Window9RectPos.right,Window9RectPos.bottom,Memdc,0,0,Window9RectPos.right,Window9RectPos.bottom,H_Alpha_VALUE)
		EndIf
		Function = ReleaseDC(wind___ , MainDC)
		wind___=0
		DeleteObject(hbitmapMaindraw)
	EndIf
	DeleteDC(MemDC)
End Function

Function LineDraw (ByVal x As Integer,ByVal y As Integer,ByVal x1 As Integer,ByVal y1 As Integer,ByVal width_ As Integer=0,ByVal color_ As Integer=0,ByVal style As Integer=PS_SOLID) As Integer Export
	Dim pen As integer
	Dim point_ As point_
	If color_=-1 Then
		pen=Cast(Integer,GetStockObject(NULL_PEN))
	Else
		pen=Cast(Integer,CreatePen(Style,width_,color_))
	EndIf
	SelectObject(Cast(HDC,MemDC),Cast(hgdiobj,pen))
	MoveToEx(MemDC, x,y,Cast(LPPOINT,@point_))
	Function= LineTo(MemDC,x1,y1)
	DeleteObject(Cast(HGDIOBJ,pen))
End Function

Function PixDraw(ByVal x As Integer,ByVal y As Integer,ByVal Color_ As Integer) As Integer Export
	Return SetPixel(MemDC,x,y,color_)
End Function

Function GetPix(ByVal x As Integer,ByVal y As Integer) As Integer export
	Return GetPixel(MemDC,x,y)
End Function

Function BoxDraw(ByVal x As Integer,ByVal y As Integer,ByVal width_ As Integer,ByVal height_ As Integer,ByVal ColorPen As Integer=0,ByVal ColorBk As Integer=0,ByVal widthPen As Integer=0,ByVal StylePen As Integer=PS_SOLID,ByVal AlPHAPARAM As Integer=255) As Integer Export
	Dim As HBRUSH brush
	Dim As Integer pen
	If ColorBk<>-1 Then
		brush=CreateSolidBrush(Cast(COLORREF,ColorBk))
		pen=Cast(Integer,CreatePen(stylepen,widthPen,Cast(COLORREF,colorpen)))
	Else
		brush=GetStockObject(NULL_BRUSH )
		pen=Cast(Integer,CreatePen(stylepen,widthPen,Cast(COLORREF,colorpen)))
	EndIf
	If AlPHAPARAM=255 Then
		SelectObject(MemDC,brush)
		SelectObject(MemDC,Cast(HGDIOBJ,pen))
		Function =  Rectangle(MemDC,x,y,x+width_,y+height_)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
	Else
		Dim As HDC hhdd=Cast(HDC,CreateCompatibleDC(0))
		Dim hnh As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(Cast(HDC,hhdd),Cast(hbitmap,hnh))
		SelectObject(hhdd,brush)
		SelectObject(hhdd,Cast(HGDIOBJ,pen))
		Function =  Rectangle(hhdd,x,y,x+width_,y+height_)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		AlphaBlend(MemDC, _
		x, _
		y, _
		width_, _
		height_, _
		hhdd, _
		x, _
		y, _
		width_, _
		height_, _
		blendFunction)
		DeleteDC(hhdd)
		DeleteObject(Cast(HGDIOBJ,hnh))
	endif
End Function
Function RoundBoxDraw(ByVal x As Integer,ByVal y As Integer,ByVal width_ As Integer,ByVal height_ As Integer,ByVal ColorPen As Integer=0,ByVal ColorBk As Integer=0,ByVal widthPen As Integer=0,ByVal StylePen As Integer=PS_SOLID,ByVal ellipsewidth As Integer=0,ByVal ellipseheight As Integer=0, ByVal AlPHAPARAM As Integer=255) As Integer Export
	Dim As HBRUSH brush
	Dim As Integer pen
	If ColorBk<>-1 Then
		brush=CreateSolidBrush(Cast(COLORREF,ColorBk))
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	Else
		brush=GetStockObject(NULL_BRUSH )
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	EndIf
	If AlPHAPARAM=255 Then
		SelectObject(MemDC,brush)
		SelectObject(MemDC,Cast(HGDIOBJ,pen))
		Function =  RoundRect(MemDC,x,y,x+width_,y+height_,ellipsewidth,ellipseheight)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
	Else
		Dim As HDC hhdd=Cast(HDC,CreateCompatibleDC(0))
		Dim hnh As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(Cast(HDC,hhdd),Cast(hbitmap,hnh))
		SelectObject(hhdd,brush)
		SelectObject(hhdd,Cast(HGDIOBJ,pen))
		Function =  RoundRect(hhdd,x,y,x+width_,y+height_,ellipsewidth,ellipseheight)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		AlphaBlend(MemDC, _
		x, _
		y, _
		width_, _
		height_, _
		hhdd, _
		x, _
		y, _
		width_, _
		height_, _
		blendFunction)
		DeleteDC(hhdd)
		DeleteObject(Cast(HGDIOBJ,hnh))
	EndIf
End Function
Function RoundDraw(ByVal x As Integer,ByVal y As Integer,ByVal width_ As Integer,ByVal height_ As Integer,ByVal ColorPen As Integer=0,ByVal ColorBk As Integer=0,ByVal widthPen As Integer=0,ByVal StylePen As Integer=PS_SOLID, ByVal AlPHAPARAM As Integer=255) As Integer export
	Dim As Integer pen
	Dim As HBRUSH brush
	If ColorBk<>-1 Then
		brush=CreateSolidBrush(ColorBk)
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	Else
		brush=GetStockObject(NULL_BRUSH )
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	EndIf
	If AlPHAPARAM=255 Then
		SelectObject(MemDC,brush)
		SelectObject(MemDC,Cast(HGDIOBJ,pen))
		Function = Ellipse(MemDC,x,y,x+width_,y+height_)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
	Else
		Dim As HDC hhdd=Cast(HDC,CreateCompatibleDC(0))
		Dim hnh As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(Cast(HDC,hhdd),Cast(hbitmap,hnh))
		SelectObject(hhdd,brush)
		SelectObject(hhdd,Cast(HGDIOBJ,pen))
		Function = Ellipse(hhdd,x,y,x+width_,y+height_)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		AlphaBlend(MemDC, _
		x, _
		y, _
		width_, _
		height_, _
		hhdd, _
		x, _
		y, _
		width_, _
		height_, _
		blendFunction)
		DeleteDC(hhdd)
		DeleteObject(Cast(HGDIOBJ,hnh))
	EndIf
End Function
Function CircleDraw(ByVal x As Integer,ByVal y As Integer,ByVal radius As Integer,ByVal ColorPen As Integer=0,ByVal ColorBk As Integer=0,ByVal widthPen As Integer=0,ByVal StylePen As Integer=PS_SOLID, ByVal AlPHAPARAM As Integer=255) As Integer export
	Dim As Integer pen
	Dim As HBRUSH brush
	If ColorBk<>-1 Then
		brush=CreateSolidBrush(ColorBk)
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	Else
		brush=GetStockObject(NULL_BRUSH )
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	EndIf
	If AlPHAPARAM=255 Then
		SelectObject(MemDC,brush)
		SelectObject(MemDC,Cast(HGDIOBJ,pen))
		Function = Ellipse(MemDC,x-radius,y-radius,x+radius,y+radius)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
	Else
		Dim As HDC hhdd=Cast(HDC,CreateCompatibleDC(0))
		Dim hnh As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(Cast(HDC,hhdd),Cast(hbitmap,hnh))
		SelectObject(hhdd,brush)
		SelectObject(hhdd,Cast(HGDIOBJ,pen))
		Function = Ellipse(hhdd,x-radius,y-radius,x+radius,y+radius)
		DeleteObject(Cast(HGDIOBJ,brush))
		DeleteObject(Cast(HGDIOBJ,pen))
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		Var ll=radius*2
		AlphaBlend(MemDC, _
		x-radius, _
		y-radius, _
		ll, _
		ll, _
		hhdd, _
		x-radius, _
		y-radius, _
		ll, _
		ll, _
		blendFunction)
		DeleteDC(hhdd)
		DeleteObject(Cast(HGDIOBJ,hnh))
	EndIf
End Function
Private Sub RezerveFont(fontdraw_ As HFONT)
	RezerveFont_=FontDraw_
End sub
Function FontDraw(ByVal FontID As HFONT) As Integer Export
	RezerveFont(FontID)
	Return Cast(Integer,SelectObject(MemDC,Cast(HGDIOBJ,FontID)))
End Function
Function TextDraw(ByVal x As Integer,ByVal y As Integer,ByVal string_ As string,ByVal ColorBK As Integer=0,ByVal ColorText As Integer=0, ByVal AlPHAPARAM As Integer=255) As Integer export
	If AlPHAPARAM=255 Then
		If ColorBk=-1 Then
			SetBkMode(MemDC,1)
		Else
			SetBkColor(MemDC,ColorBk)
		EndIf
		SetTextColor(MemDC,ColorText)
		Function = TextOut(MemDC,x,y,string_, Len(string_))
	Else
		Dim As HDC hhdd=Cast(HDC,CreateCompatibleDC(0))
		Dim hnh As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(Cast(HDC,hhdd),Cast(hbitmap,hnh))
		If RezerveFont_<>0 Then
			SelectObject(hhdd,Cast(HGDIOBJ,RezerveFont_))
		EndIf
		If ColorBk=-1 Then
			SetBkMode(hhdd,1)
		Else
			SetBkColor(hhdd,ColorBk)
		EndIf
		SetTextColor(hhdd,ColorText)
		Var leenn=Len(string_)
		Function = TextOut(hhdd,x,y,string_, leenn)
		Dim As SIZE size
		GetTextExtentPoint32(hhdd,string_ , leenn, @SIZE)
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		AlphaBlend(MemDC, _
		x, _
		y, _
		size.cx, _
		size.cy, _
		hhdd, _
		x, _
		y, _
		size.cx, _
		size.cy, _
		blendFunction)
		DeleteDC(hhdd)
		DeleteObject(Cast(HGDIOBJ,hnh))
	EndIf
End Function
Function PolylineDraw(ByVal pPoint As POINT Ptr,ByVal nCount As Integer,ByVal ColorPen As Integer=0,ByVal widthPen As Integer=0,ByVal StylePen As Integer=PS_SOLID) As Integer export
	Dim As Integer pen
	pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	SelectObject(MemDC,Cast(HGDIOBJ,pen))
	Function = Polyline (MemDC, pPoint, nCount)
	DeleteObject(Cast(HGDIOBJ,pen))
End Function
Function PolygonDraw(ByVal pPoint As POINT ptr,ByVal nCount As Integer,byval FillColor as integer,ByVal BorderColor As Integer=0,ByVal BorderWidth As Integer=0,ByVal BorderStyle As Integer=PS_SOLID) As Integer export
  Dim As HGDIOBJ oldPen   = SelectObject(MemDC,CreatePen(BorderStyle,BorderWidth,BorderColor))
  Dim As HGDIOBJ oldBrush = SelectObject(MemDC,CreateSolidBrush(FillColor))
  Function = Polygon(MemDC, pPoint, nCount)
  DeleteObject(SelectObject(MemDC,oldBrush))
  DeleteObject(SelectObject(MemDC,oldPen))
End Function
Function ImageDraw(ByVal bitmap_ As HBITMAP,ByVal x As Integer, ByVal y As Integer, ByVal AlPHAPARAM As Integer=255) As Integer Export
	Dim As HDC hdc=CreateCompatibleDC(Maindc)
	Dim size As BITMAP
	getobject(Cast(HBITMAP,bitmap_),sizeof(BITMAP),@size)

	If AlPHAPARAM=255 Then
		Var oldObj = SelectObject(hdc,bitmap_)
		Function = BitBlt(MemDC, x, y,size.bmWidth , size.bmHeight,hdc, 0, 0, SRCCOPY)
		SelectObject(hdc,oldObj)
	Else
		Dim As HDC hdc2=CreateCompatibleDC(Maindc)
		Dim hbitmap As hBitmap=CopyImage(hbitmapMaindraw,IMAGE_BITMAP,0,0,LR_COPYRETURNORG)
		SelectObject(hdc,hbitmap)
		Var oldObj = SelectObject(hdc2,bitmap_)
		Function = BitBlt(hdc, x, y,size.bmWidth , size.bmHeight,hdc2, 0, 0, SRCCOPY)
		Dim as BLENDFUNCTION blendFunction
		blendFunction.BlendOp = AC_SRC_OVER
		blendFunction.SourceConstantAlpha = cast(byte,AlPHAPARAM )
		AlphaBlend(MemDC, _
		x, _
		y, _
		size.bmWidth, _
		size.bmHeight, _
		hdc, _
		x, _
		y, _
		size.bmWidth, _
		size.bmHeight, _
		blendFunction)
		SelectObject(hdc,oldObj)
		DeleteObject(Cast(HGDIOBJ,hbitmap))
		DeleteDC(hdc2)
	EndIf
	DeleteDC(hdc)
End Function
Function FillRectDraw(ByVal x As Integer, ByVal y As Integer, ByVal Color_ As Integer) As Integer Export
	Var  brush=CreateSolidBrush(Color_ )
	SelectObject(MemDC,brush)
	Function=ExtFloodFill ( MemDc, x, y,GetPixel(MemDC,x,y), FLOODFILLSURFACE)
	DeleteObject(brush)
End Function
Function FocusDraw(ByVal x As Integer, ByVal y As Integer, ByVal width_ As Integer, ByVal height_ As Integer) As Integer Export
	Dim As RECT frect
	frect.right=width_+x
	frect.bottom=height_+y
	frect.left=x
	frect.top=y
	Return DrawFocusRect(MemDC,@frect)
End Function
Function IconDraw(ByVal x As Integer, ByVal y As Integer, ByVal Hicon As HICON) As Integer Export
	Return DrawIcon(MemDC,x,y,Hicon)
End Function
Function GradientFillDraw  Alias "GradientFillDrawWINDOW9"(ByVal x As Integer, ByVal y As Integer,ByVal width_ As Integer, ByVal height_ As Integer,ByVal Rbegin As Integer,ByVal Gbegin As Integer,ByVal Bbegin As Integer,ByVal REnd As Integer,ByVal GEnd As Integer,ByVal BEnd As Integer, ByVal GOR_VERT As bool=0)As Integer Export
	Dim  As TRIVERTEX vert(0 to 1)
	Dim As GRADIENT_RECT gRect
	vert(0).x      = x
	vert(0).y      = y
	vert(0).Red    = Rbegin
	vert(0).Green  = Gbegin
	vert(0).Blue   = Bbegin
	vert(0).Alpha  = 0
	vert(1).x      = width_+x
	vert(1).y      = height_+y
	vert(1).Red    = Rend
	vert(1).Green  = Gend
	vert(1).Blue   = Bend
	vert(1).Alpha  = 0
	gRect.UpperLeft  = 1
	gRect.LowerRight = 0
	Return GradientFill( MemDC, @vert(0), 2, @gRect, 1, GOR_VERT )
End Function
Function PieDraw(ByVal x As Integer,_
	ByVal y As Integer,_
	ByVal width_ As Integer,_
	ByVal height_ As Integer,_
	ByVal x1 As Integer,_
	ByVal y1 As Integer,_
	ByVal x2 As Integer,_
	ByVal y2 As Integer,_
	ByVal ColorPen As Integer=0,_
	ByVal ColorBk As Integer=0,_
	ByVal widthPen As Integer=0,_
	ByVal StylePen As Integer=PS_SOLID) As Integer export
	Dim As Integer pen
	Dim As HBRUSH brush
	If ColorBk<>-1 Then
		brush=CreateSolidBrush(ColorBk)
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	Else
		brush=GetStockObject(NULL_BRUSH )
		pen=Cast(Integer,CreatePen(stylepen,widthPen,colorpen))
	EndIf
	SelectObject(MemDC,brush)
	SelectObject(MemDC,Cast(HGDIOBJ,pen))
	Function = Pie(MemDC,x,y,x+width_,y+height_,x1,y1,x2,y2)
	DeleteObject(Cast(HGDIOBJ,brush))
	DeleteObject(Cast(HGDIOBJ,pen))
End Function
