Here you go, I've fixed it up.
There were several lines missing/messed up where you'd copied the CreateImageRegion function over, dunno how that happened
Also, when you use
Function=0
to return from a function, it doesn't do what you think it does. If you want to return immediately, you need to use
Return 0
otherwise the code keeps running in the same function and only drops out at the end, by that time Function might have had another value set in to it.
i.e.
Function foo(byval p as integer) as Integer
if p=1 then
Function=0
else
Function=1
end
Function=2
End Function
This function always returns 2!
I've changed the code to do
Function foo(byval p as integer) as Integer
if p=1 then
Return 0
else
Return 1
end
Return 2
End Function
This was why you didn't see anything - the WndProc was returning totally wrong values.
I fixed the mask colour on the SkinBuffer.
I fixed the window region to be created/applied AFTER ths skin image had been loaded!!!
I changed the Window styles and ex-styles.
'
' Clyde Gets Into Windows.
' October 2008
'
Option Static
#Include Once "Windows.bi"
#Include Once "crt.bi"
#Include Once "media\skin1p.bas"
#Include Once "media\skin1r.bas"
#Include Once "media\FaceP.bas"
#Include Once "media\FaceR.bas"
#Include Once "media\Face2P.bas"
#Include Once "media\Face2R.bas"
Const MAXBUTTONS =3
Const PLAY_BUTTON =0
Const PAUSE_BUTTON =1
Const CLOSE_BUTTON =2
Const As Single PI=3.14159265
Const As Single D2R=PI/180.0
Const XRES=512
Const YRES=256
Const APPNAME As String="wInDoWs FrAmEwOrK"
Type GfxBuffer
wwidth As Integer
height As Integer
mask As UInteger
pixels As UInteger pointer
End Type
Type Button
Region As HRGN
Rect As RECT
PosX As Integer
PosY As Integer
Image1 As GFXBuffer Pointer
Image2 As GFXBuffer Pointer
State As Integer
End Type
Dim Shared As HRGN WindowRegion
Dim Shared As GfxBuffer Pointer SkinBuffer, PlasmaBuffer, Palette1
Dim Shared As Button Pointer Button( 0 To MAXBUTTONS-1 )
Dim Shared As Single Cosine( 0 To 1500 )
Dim Shared As Integer wave1,wave2,wave3
Declare Sub ApplyWindowRegion( ByVal hWnd As HWND )
Declare Sub DrawButton ( ByVal hdc as HDC,_
ByVal Buton As Button Pointer )
Declare Sub DrawGFXBuffer( ByVal Dest As HDC,_
ByVal Source As GfxBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Declare Sub InitializeWindows()
Declare Sub UpdatePlasma( ByVal Dest As HDC,_
ByVal Source As GFXBuffer Pointer,_
ByVal Pal As GFXBuffer Pointer,_
ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal PosX As Integer=0,_
ByVal PosY As Integer=0 )
Declare Function CreateButton( ByVal Image1 As GFXBuffer Pointer,_
ByVal Image2 As GFXBuffer Pointer,_
ByVal StartPosX As Integer,_
ByVal StartPosY As Integer ) As Button Pointer
Declare Function CreateButtonRegion( ByVal PosX0 As Integer,_
ByVal PosY0 As Integer,_
ByVal PosX1 As Integer,_
ByVal PosY1 As Integer) As HRGN
Declare Function CreateImageRegion( ByVal Image As GFXBuffer Pointer ) As HRGN
Declare Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer,_
ByVal Mask As Uinteger=0 ) As GfxBuffer Pointer
Declare Function CreatePal( ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal Divv As Integer=360) As GFXBuffer Pointer
Declare Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer,_
ByVal Mask As UInteger=0 ) As GfxBuffer Pointer
Declare Function WndProc ( ByVal hWnd As HWND,_
ByVal message As UINT,_
ByVal wParam As WPARAM,_
ByVal lParam As LPARAM ) As LRESULT
Declare Function WinMain ( ByVal hInstance As HINSTANCE,_
ByVal hPrevInstance As HINSTANCE,_
ByRef szCmdLine As String,_
ByVal iCmdShow As Integer ) As Integer
WinMain( GetModuleHandle( Null ), Null, Command, SW_NORMAL )
End
Sub ApplyWindowRegion( ByVal hWnd As HWND )
SetWindowRgn( hWnd, WindowRegion, TRUE )
End Sub
Sub DrawButton( ByVal hdc as HDC,_
ByVal Buton As Button Pointer )
Select Case As Const Buton->State
Case 0:
DrawGFXBuffer( hdc, Buton->Image1, Buton->PosX, Buton->PosY )
Case 1:
DrawGFXBuffer( hdc, Buton->Image2, Buton->PosX, Buton->PosY )
End Select
End Sub
Sub DrawGFXBuffer( ByVal Dest As HDC,_
ByVal Source As GfxBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Dim bmi As BITMAPINFO
With bmi.bmiheader
.biSize = SizeOf (BITMAPINFOHEADER)
.biWidth = Source->WWidth
.biHeight = -Source->Height
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = 0
.biClrUsed = 0
.biClrImportant = 0
.biXPelsPerMeter = 75
.biYPelsPerMeter = 75
End With
SetDIBitsToDevice( Dest,_
PosX,_
PosY,_
Source->WWidth,_
Source->Height,_
0,_
0,_
0,_
Source->Height,_
@Source->Pixels[0],_
@bmi,_
DIB_RGB_COLORS )
End Sub
Sub InitializeWindows()
SkinBuffer=LoadGraphics8Bit(XRES,YRES,@skinmk1r(0),@skinmk1p(0),&HFF00FF)
WindowRegion=CreateImageRegion( SkinBuffer )
PlasmaBuffer=CreateGFXBuffer( 437, 152, &HFF00FF )
Dim As GFXBuffer Ptr Image1= LoadGraphics8bit(32,32,@facer(0),@facep(0))
Dim As GFXBuffer Ptr Image2= LoadGraphics8bit(32,32,@facer2(0),@facep2(0))
Dim As GFXBuffer Ptr Image3= LoadGraphics8bit(32,32,@facer(0),@facep(0))
Dim As GFXBuffer Ptr Image4= LoadGraphics8bit(32,32,@facer2(0),@facep2(0))
Button(0)=CreateButton( Image1,_
Image2,_
100,_
188 )
Button(1)=CreateButton( Image1,_
Image2,_
280,_
188 )
Button(2)=CreateButton( Image1,_
Image2,_
460,_
8 )
Palette1=CreatePal(10,45,90)
Dim As Integer a
For a=0 To 1499
Cosine( a ) = Cos( (( 115*PI * a ) / PlasmaBuffer->WWidth )*D2R ) * 128
Next
End Sub
Sub UpdatePlasma( ByVal Dest As HDC,_
ByVal Source As GFXBuffer Pointer,_
ByVal Pal As GFXBuffer Pointer,_
ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal PosX As Integer=0,_
ByVal PosY As Integer=0 )
Dim bmi As BITMAPINFO
With bmi.bmiheader
.biSize = SizeOf (BITMAPINFOHEADER)
.biWidth = Source->WWidth
.biHeight = -Source->Height
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
.biSizeImage = 0
.biClrUsed = 0
.biClrImportant = 0
End With
Dim As Integer x,y,d,f
For y = 0 To Source->Height-1
d = cosine( y + wave2 ) + cosine( y + wave3 )
For x = 0 To Source->WWidth-1
f = cosine( x + wave1 ) + cosine( x + y ) + d And 255
Source->Pixels [ x+y*Source->WWidth ]=Pal->Pixels[ f And 255 ]
Next
Next
wave1+=Val1 : If wave1 >= Source->WWidth-1 Then wave1 = wave1 - Source->WWidth
wave2+=Val2 : If wave2 >= Source->WWidth-1 Then wave2 = wave2 - Source->WWidth
wave3+=Val3 : If wave3 >= Source->WWidth-1 Then wave3 = wave3 - Source->WWidth
SetDIBitsToDevice( Dest,_
PosX,_
PosY,_
Source->WWidth,_
Source->Height,_
0,_
0,_
0,_
Source->Height,_
@Source->Pixels[0],_
@bmi,_
DIB_RGB_COLORS )
End Sub
Function CreateButton( ByVal Image1 As GFXBuffer Pointer,_
ByVal Image2 As GFXBuffer Pointer,_
ByVal StartPosX As Integer,_
ByVal StartPosY As Integer ) As Button Pointer
Dim Btn As Button Pointer=Callocate(Len( Button )+Len( UInteger ))
Btn->PosX=StartPosX
Btn->PosY=StartPosY
Btn->Image1=Image1
Btn->Image2=Image2
Btn->State=0
Btn->Region=CreateButtonRegion( StartPosX,_
StartPosY,_
StartPosX+Btn->Image1->WWidth,_
StartPosY+Btn->Image1->Height )
Btn->Rect.left =StartPosX
Btn->Rect.top =StartPosY
Btn->Rect.right =StartPosX+Btn->Image1->WWidth
Btn->Rect.bottom=StartPosY+Btn->Image1->Height
Function=Btn
End Function
Function CreateButtonRegion( ByVal PosX0 As Integer,_
ByVal PosY0 As Integer,_
ByVal PosX1 As Integer,_
ByVal PosY1 As Integer) As HRGN
Dim Region As HRGN
Region=CreateRectRgn( PosX0,_ ' x-coordinate of region's upper-left corner
PosY0,_ ' y-coordinate of region's upper-left corner
PosX1,_ ' x-coordinate of region's lower-right corner
PosY1 ) ' y-coordinate of region's lower-right corner
Function=Region
End Function
Function CreatePal( ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal Divv As Integer=720) As GFXBuffer Pointer
Dim As GFXBuffer Pointer Pal=CreateGFXBuffer(1,256)
Dim As Integer a, red, grn, blu
Dim As Single m
For a=0 to 255
m = a*(Divv/255)
red = cos( (m+Val1)*D2R ) *127+127
grn = cos( (m+Val2)*D2R ) *127+127
blu = cos( (m+Val3)*D2R ) *127+127
Pal->Pixels[ a*Pal->WWidth ] = rgb(red,grn,blu)
Next
Return Pal
End Function
Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer,_
ByVal Mask As UInteger=0 ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=Callocate(Len( GfxBuffer )+Len( UInteger )*WWidth*Height)
Buffer->wwidth=WWidth
Buffer->height=Height
Buffer->Mask =Mask
Buffer->pixels=Cast( UInteger Pointer, Cast( Byte Pointer, Buffer )+Len( GfxBuffer ))
Function=Buffer
End Function
Function CreateImageRegion( ByVal Image As GFXBuffer Pointer ) As HRGN
Dim As Integer inout, start, x, y
Dim As Rect RegionRect
Dim As HRGN Region
Region = CreateRectRgn(0,0,0,0)
for y=0 to Image->Height-1
If Image->pixels[ (0+y)*Image->WWidth ]=Image->Mask Then
'
' Transparent.
'
inout=0
Else
'
' Solid.
'
inout=1
EndIf
start=0
For x = 1 to Image->WWidth-1
'
' Gone from Solid To Transparent.
'
If inout=1 And Image->Pixels[ x+y*Image->WWidth ]=Image->Mask Then
'
' Make a rectangle from 'start' to x, y to y+1
'
With RegionRect
.Left =Start
.Right =x
.Top =y
.Bottom=y+1
End With
CombineRgn( region, region, CreateRectRgnIndirect(@RegionRect),RGN_OR)
inout=0
'
' Gone from transparent to solid.
'
ElseIf (inout=0) And (Image->pixels[x+y*Image->WWidth]<>Image->Mask) Then
Start=x
inout=1
EndIf
Next
'
' Ended up solid, so make a rectangle to the right hand side of the window.
'
If inout=1 Then
'
' Make a rectangle from 'start' to 'width'-1, y to y+1
'
With RegionRect
.Left =Start
.Right =Image->WWidth-1
.Top =y
.Bottom =y+1
End With
CombineRgn( region, region, CreateRectRgnIndirect(@RegionRect),RGN_OR)
End If
Next
Function=Region
End Function
Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer,_
ByVal Mask As UInteger=0 ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=CreateGFXBuffer( WWidth, Height, Mask )
Dim As UInteger pal(0 to 255)
Dim As Integer a,x,y
'
' Retrieve Palette Info.
'
For a=0 to 255
pal(a)=(palet[a*3] Shl 16) Or (palet[a*3+1] Shl 8) Or(palet[a*3+2])
Next
'
' Make Image Based On Colour Indexing With The Raw values.
'
For y=0 to Height-1
For x=0 to WWidth-1
Buffer->Pixels[ x+y*WWidth ]=Pal(Raw[x+y*WWidth])
Next
Next
Function=Buffer
End Function
Function WndProc ( ByVal hWnd As HWND,_
ByVal message As UINT,_
ByVal wParam As WPARAM,_
ByVal lParam As LPARAM ) As LRESULT
Dim As PAINTSTRUCT SBuffer
Dim As HDC hDC
Dim As Integer MouseX, MouseY, a
Select Case ( message )
Case WM_CREATE
InitializeWindows()
ApplyWindowRegion ( hWnd )
Case WM_TIMER
InvalidateRect(hWnd, NULL, False)
Case WM_ERASEBKGND
return 1
Case WM_PAINT
hdc = BeginPaint( hWnd, @SBuffer )
DrawGFXBuffer( hdc, SkinBuffer, 0, 0 )
UpdatePlasma( hdc, PlasmaBuffer, Palette1, 2, 4, 2, 38, 30 )
For a=0 To MAXBUTTONS-1
DrawButton( hdc, Button(a) )
Next
EndPaint( hWnd, @SBuffer )
case WM_LBUTTONDOWN
'If Button( PLAY_BUTTON )->State=1 Then Action1()
'If Button( PAUSE_BUTTON )->State=1 Then Action2()
'
' Close The Window / Terminate application
'
If Button(CLOSE_BUTTON)->State=1 Then PostMessage( hWnd, WM_CLOSE, 0, 0 )
'
' Trick into moving window.
'
SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, Null )
Case WM_MOUSEMOVE
MouseX = LoWord(lParam)
MouseY = HiWord(lParam)
For a=0 To MAXBUTTONS-1
If (PtInRegion(Button(a)->Region, MouseX, MouseY) <> 0) then
Button(a)->State=1
Else
Button(a)->State=0
End if
Next
Case WM_KEYDOWN
Select Case LoByte( wParam )
Case VK_ESCAPE
PostMessage( hWnd, WM_CLOSE, 0, 0 )
End Select
Case WM_DESTROY
PostQuitMessage( 0 )
case else
return DefWindowProc( hWnd, message, wParam, lParam )
End Select
return 0
End function
Function WinMain ( ByVal hInstance As HINSTANCE,_
ByVal hPrevInstance As HINSTANCE,_
ByRef szCmdLine As String,_
ByVal iCmdShow As Integer ) As Integer
Dim wMsg As MSG
Dim wClass As WNDCLASS
Dim hWnd As HWND
With wClass
.style = CS_HREDRAW or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon( null, IDI_APPLICATION )
.hCursor = LoadCursor( null, IDC_ARROW )
.hbrBackground = null
.lpszMenuName = null
.lpszClassName = StrPtr( APPNAME )
End With
If( RegisterClass( @wClass ) = False ) Then
MessageBox( Null,"Sorry there dude. Unable To Register Class", APPNAME, MB_ICONERROR )
Exit Function
End If
Dim As Integer SystemW, SystemH
Dim As Integer CenterX, CenterY
SystemW = GetSystemMetrics(SM_CXSCREEN)
SystemH = GetSystemMetrics(SM_CYSCREEN)
CenterX = ( SystemW - XRES )/2
CenterY = ( SystemH - YRES )/2
hWnd = CreateWindowEx( WS_EX_COMPOSITED Or WS_EX_LAYERED,_
APPNAME,_
APPNAME,_
WS_POPUP Or WS_VISIBLE,_
CenterX,_
CenterY,_
XRES,_
YRES,_
null,_
null,_
hInstance,_
null )
ShowWindow ( hWnd, iCmdShow )
UpdateWindow ( hWnd )
SetTimer(hWnd,0,1000/60,null)
While ( GetMessage( @wMsg, null, 0, 0 ) > 0)
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Wend
Function = wMsg.wParam
End Function
