Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Clyde on October 07, 2008
-
Hello out there,
I am fairly new to creating windows apps; know just about the basics, and have made a framework from looking at the Freebasic examples folder; and put in support for loading 8Bit images using Rbz's Bmp2Raw & Bin2Bas.
My aim for the future is to create a skinable application with button; these I beileve are drawn using 4 positions of a rectangles and a region. As discovered in an earlier topic about having some problems with running and compiling into the examples folders with windows vista 32-bit, from Jim.
First I'd like to know if im going about setting up the bmp / image correctly. Im not entirely sure where I should be putting my graphic loading stuff; I had thought of putting it into the WM_Create case statement, but I dont think thats right as the image will be created each loop of that function; unless I am mistaken and it only cycles that part once.
I want to keep the gfxbuffer pointer type as is thanks, and im fully aware that I may have to send it via the subs / functiuon calls,. as I have found that it can't be made Global ( Shared ). Also I may need to add other elements to the type.
I am not entirely sure if the drawgfxbuffer routine will work either and where that should go in the wndproc function, and at present it has no positioning. Also dont understand these settings: .biXPelsPerMeter = 75,
.biYPelsPerMeter = 75
Another concern is how to get the HWnd and feed it to the sub for the SetDIBitsToDevice.
I know there's quite a few queries and bits i am stuck on, and any assistance and help fixing and pointing out the problems / solutions is very much appreciated.
Hope that I've made enough sense.
Please find attached win framework and image data,
Cheers and huge thanks,
Clyde.
-
http://jwz.livejournal.com/123070.html (http://jwz.livejournal.com/123070.html)
-
Ok thanks Jim, I must of missed something on that link, as most of them talk about not liking skinned windows.
My first problem is dealing with displaying images; not entirely sure where I should be putting that etc, and how wndproc works? I've noticed that some people put media into WM_Create; but doesnt that reload the data each time?
Cheers,
Clyde
-
some people put media into WM_Create; but doesnt that reload the data each time?
depends on how often you create your window ;)
a skinable application with button; these I beileve are drawn using 4 positions of a rectangles
A single button is indeed easy. It's getting more interessting when you have a complex user-interface with hierarchical structures and subframes.
Here you need some sort of layouting-mechanism which dynamically assigns the available space to the different elements.
Better invest some thoughts into that before starting anything.
-
I think it would be quicker, if the window was only created once.
And as I've not dealt with windows before; apart from the framework which I adapted from the examples with FB21. I would really appreciate some help in getting me started in drawing images onto a window.
Cheers and many thanks,
Clyde.
-
I've fixed up your framework to draw the graphic you supplied (not much to look at).
WndProc gets called with WM_CREATE only once, so you can load all your stuff there.
WM_PAINT gets called every time Windows wants to repaint the window (usually if it gets uncovered, comes back on the screen, gets restored, etc). If you want static stuff, that's all you need to do. If you want animating stuff, we can arrange for a timer to go off regularly which can, in turn, make WM_PAINT get called. This is what I'm doing in my retro-remake to get 50Hz.
'
' Clyde Gets Into Windows.
' October 2008
'
Option Explicit
#Include Once "Windows.bi"
#Include Once "crt.bi"
#Include Once "media\FaceP.bas"
#Include Once "media\FaceR.bas"
Const XRES=640
Const YRES=480
Const APPNAME As String="Windows Framework"
Type GfxBuffer
wwidth As Integer
height As Integer
pixels As UInteger pointer
End Type
Declare Sub DrawGfxBuffer( ByVal hdc As HDC,_
ByVal Source As GfxBuffer Pointer )
Declare Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As integer ) As GfxBuffer Pointer
Declare Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) 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
'
' Load Graphics into pointers types.
'
Dim As GfxBuffer Pointer TestImage=LoadGraphics8Bit( 32, 32, @FaceR(0), @FaceP(0) )
WinMain( GetModuleHandle( Null ), Null, Command, SW_NORMAL )
End
Sub DrawGfxBuffer(ByVal hdc as HDC, ByVal Source As GfxBuffer Pointer )
Dim bmi As BITMAPINFO
With bmi.bmiheader
.biSize = SizeOf (BITMAPINFOHEADER)
.biWidth = Source->WWidth
.biHeight = -Source->Height
.biPlanes = 1
.biBitCount = 8
.biCompression = BI_RGB
.biSizeImage = 0
.biXPelsPerMeter = 75
.biYPelsPerMeter = 75
.biClrUsed = 0
.biClrImportant = 0
End With
SetDIBitsToDevice(hdc, 0,0, Source->WWidth, Source->Height, 0, 0, 0, Source->Height, @Source->Pixels[0], @bmi,
DIB_RGB_COLORS)
End Sub
dim shared as GfxBuffer Pointer myGfx
Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=Callocate(Len( GfxBuffer )+Len( UInteger )*WWidth*Height)
Buffer->wwidth=WWidth
Buffer->height=Height
Buffer->pixels=Cast( UInteger Pointer, Cast( Byte Pointer, Buffer )+Len( GfxBuffer ))
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 Render
Dim As HDC hDC
Select Case ( message )
Case WM_CREATE
myGfx = LoadGraphics8bit(32,32,@facer(0),@facep(0))
Function=0
Case WM_PAINT
hDC = BeginPaint( hWnd, @Render )
DrawGfxBuffer(hdc, myGfx)
EndPaint( hWnd, @Render )
Function=0
Case WM_KEYDOWN
Select Case LoByte( wParam )
Case VK_ESCAPE
PostMessage( hWnd, WM_CLOSE, 0, 0 )
Function=0
End Select
Case WM_DESTROY
PostQuitMessage( 0 )
Function=0
End Select
Function=DefWindowProc( hWnd, message, wParam, lParam )
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
Function = 0
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 = GetStockObject( BLACK_BRUSH )
.lpszMenuName = null
.lpszClassName = StrPtr( APPNAME )
end with
If( RegisterClass( @wClass ) = False ) Then
Exit Function
End If
hWnd = CreateWindowEx( 0,_
APPNAME,_
APPNAME,_
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT,_
CW_USEDEFAULT,_
XRES,_
YRES,_
null,_
null,_
hInstance,_
null )
ShowWindow( hWnd, iCmdShow )
UpdateWindow( hWnd )
While ( GetMessage( @wMsg, null, 0, 0 ) <> False )
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Wend
Function = wMsg.wParam
End Function
Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=CreateGFXBuffer( WWidth, Height )
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
<edit>
.biXPelsPerMeter = 75
This is just setting the dpi (dots per inch) for the bitmap. Really only useful if you're intending to print it on a printer. 75 is a sensible default. If you are trying for tiny code then 0 might also work.
Jim
-
Thankyou so much mate.
-
Only problem is, after properly using it, that the image isn't appearing as should be see below for actual image.
Also the myGFX should be Dimmed as a GFXBuffer pointer, but this crashes the window.
Not entirely sure on the calls from
SetDIBitsToDevice(hdc, 0,0, Source->WWidth, Source->Height, 0, 0, 0, Source->Height, @Source->Pixels[0], @bmi,
I think the 4th entry where it has, Source->WWidth - Should be Image Position X
And the 5th entry should be for image position y.
[ edit ]
I have added an update to the code Im fiddling with, I get graphics / variable name errors. if I put the the image dim bits out of the select case loop, it doesnt give errors. Which isnt the way forward, I dont think.
'
' Clyde Gets Into Windows.
' October 2008
'
Option Explicit
#Include Once "Windows.bi"
#Include Once "crt.bi"
#Include Once "media\FaceP.bas"
#Include Once "media\FaceR.bas"
Const XRES=640
Const YRES=480
Const APPNAME As String="Windows Framework"
Type GfxBuffer
wwidth As Integer
height As Integer
pixels As UInteger pointer
End Type
Declare Sub DrawGfxBuffer( ByVal hdc as HDC,_
ByVal Source As GfxBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Declare Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As integer ) As GfxBuffer Pointer
Declare Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) 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 DrawGfxBuffer( ByVal hdc 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 = 8
.biCompression = BI_RGB
.biSizeImage = 0
' .biXPelsPerMeter = 75
' .biYPelsPerMeter = 75
.biClrUsed = 0
.biClrImportant = 0
End With
'SetDIBitsToDevice(hdc, 0,0, Source->WWidth, Source->Height, 0, 0, 0, Source->Height, @Source->Pixels[0], @bmi, DIB_RGB_COLORS)
SetDIBitsToDevice(hdc, 0,0, PosX, PosY, 0, 0, 0, Source->Height, @Source->Pixels[0], @bmi, DIB_RGB_COLORS)
End Sub
Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=Callocate(Len( GfxBuffer )+Len( UInteger )*WWidth*Height)
Buffer->wwidth=WWidth
Buffer->height=Height
Buffer->pixels=Cast( UInteger Pointer, Cast( Byte Pointer, Buffer )+Len( GfxBuffer ))
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 Render
Dim As HDC hDC
Select Case ( message )
Case WM_CREATE
Dim As GfxBuffer Pointer Image1= LoadGraphics8bit(32,32,@facer(0),@facep(0))
Function=0
Case WM_PAINT
hDC = BeginPaint( hWnd, @Render )
DrawGfxBuffer(hdc, Image1, 100, 100)
EndPaint( hWnd, @Render )
Function=0
Case WM_KEYDOWN
Select Case LoByte( wParam )
Case VK_ESCAPE
PostMessage( hWnd, WM_CLOSE, 0, 0 )
Function=0
End Select
Case WM_DESTROY
PostQuitMessage( 0 )
Function=0
End Select
Function=DefWindowProc( hWnd, message, wParam, lParam )
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
Function = 0
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 = GetStockObject( BLACK_BRUSH )
.lpszMenuName = null
.lpszClassName = StrPtr( APPNAME )
end with
If( RegisterClass( @wClass ) = False ) Then
Exit Function
End If
hWnd = CreateWindowEx( 0,_
APPNAME,_
APPNAME,_
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT,_
CW_USEDEFAULT,_
XRES,_
YRES,_
null,_
null,_
hInstance,_
null )
ShowWindow( hWnd, iCmdShow )
UpdateWindow( hWnd )
While ( GetMessage( @wMsg, null, 0, 0 ) <> False )
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Wend
Function = wMsg.wParam
End Function
Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=CreateGFXBuffer( WWidth, Height )
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
[ Image Info ] Can be found in first topic download [ / Image Info ]
Cheers and many thanks,
Clyde
-
Ok, cured it for now. For some reason, even though the image is an 8bit ( 256 colours ), the bitcount needs to be 32bit. And I've found a solution to my varables for holding images conundrum.
-
Before I carry on, and ask about skinable windows, and button events ( Regions? ).
Is there some info I can get see to what SetDIBitsToDevice() actually represents, and also any info on bmpheaders? Also if one of the fields isn't greater than 0, will there be any problems in not defining it ( leaving it out ) ?
Cheers,
Clyde.
-
Obviously you can't declare the gfx variables inside the WM_CREATE part, you have to make them global. Just like any other function they won't hang around until the next time it's called.
I missed the fact you'd changed the bits to 8. In this code here
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
you are loading the 32bit palette, all 256 colours, and then for each raw pixel you are looking it up in the palette, ie. you've converted it to 32 bit.
Is there some info I can get see to what SetDIBitsToDevice()
Sure. http://msdn.microsoft.com/en-us/library/ms532346(VS.85).aspx (http://msdn.microsoft.com/en-us/library/ms532346(VS.85).aspx)
Also if one of the fields isn't greater than 0, will there be any problems in not defining it ( leaving it out ) ?
Yes. You need to define things. You might be able to memset it to 0 or declare it as a global which will make sure it's all 0s by default. If you declare it on the stack (local variable) it will be full of junk every time.
I strongly suggest getting it all working before trying stuff like that anyway.
Jim
-
Ok cool, thanks Jim. The SetDiBitsToDevice, works a bit like DrawImageRectangle ( in parts ) from Blitz.
Also had forgotten the palete and raw was being converted to 32-bit.
Next question is: How would I go about setting up a button made from an image, and then have the mouse go over it and it changes to another image; and if it's clicked performs an action ?
Cheers,
Clyde.
-
What I would do is create a type called BUTTON that holds all the information about a button, that might be:
x,y - position of button
sprite1 - normal sprite
sprite2 - selected sprite
buttonstate - whether button is selected or not
Then I'd write a function to create them from filenames and positions.
Then I'd write a function called IsMouseOverButton
delcare function IsMouseOverButton(btn as BUTTON, mousex as integer, mousey as integer) as boolean
which would find out if the mousexy is inside the button.
Then I'd have an array of buttons which I checked every time the mouse moved.
When the mouse moves, you get a WM_MOUSEMOVE message
http://msdn.microsoft.com/en-us/library/ms645616(VS.85).aspx (http://msdn.microsoft.com/en-us/library/ms645616(VS.85).aspx)
case WM_MOUSEMOVE
dim mousex as integer
dim mousey as integer
mousex = lParam and &Hffff
mousey = lParam shr 16
After that I'd check if mousex/mousey was over any of my buttons.
Then, you might need to force the window to repaint, if one of the buttons was hovered over.
To do that, call
InvalidateRect(hWnd, NULL, FALSE)
http://msdn.microsoft.com/en-us/library/ms534893(VS.85).aspx (http://msdn.microsoft.com/en-us/library/ms534893(VS.85).aspx)
Finally, I'd change WM_PAINT to run through all the buttons and draw them all.
Jim
-
I'll get cracking with this, some of it, I will have to ask you about. My first question is what is the data type for the boolean on this: IsMouseOverButton(btn as BUTTON, mousex as integer, mousey as integer) as boolean
Cheers,
Clyde.
-
Ok after having a look around mostly in the examples folders, also at Rbz's Camouflage music disk and your advice Jim. I have managed to get a very simple and primitive example of my own.
A few things, is how to use a sound scheme if it is enabled on the pc, and I'd also like to have the arrow icon change to a hand if the button performs a task. Also, what would be nice is to have a text field show, when hovering over a particular button.
And another concern is why the background plasma effect doesnt update properlly. Maybe it's in the wrong place, a bit weird that it doesnt move at all. You did mention something about timers; will see if I can find anything on that; still would like some pointers on that.
Heres the code so far:
'
' Clyde Gets Into Windows.
' October 2008
'
Option Explicit
#Include Once "Windows.bi"
#Include Once "crt.bi"
#Include Once "media\FaceP.bas"
#Include Once "media\FaceR.bas"
#Include Once "media\Face2P.bas"
#Include Once "media\Face2R.bas"
Const As Single PI=3.14159265
Const As Single D2R=PI/180.0
Const MAXBUTTONS=2
Const XRES=640
Const YRES=480
Const APPNAME As String="Windows Framework"
Type GfxBuffer
wwidth As Integer
height As Integer
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 GfxBuffer Pointer Image1,Image2, ScreenBuffer, 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 InitializeWindows()
Declare Sub UpdatePlasma( ByVal Pal As GFXBuffer Pointer,_
ByVal ScreenBuffer As GFXBuffer Pointer,_
ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer )
Declare Sub DrawButton( ByVal hdc as HDC,_
ByVal Buton As Button Pointer )
Declare Sub DrawGfxBuffer( ByVal hdc as HDC,_
ByVal Source As GfxBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
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 CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As integer ) As GfxBuffer Pointer
Declare Function CreatePalettes( ByVal WWidth As Integer,_
ByVal Height As Integer,_
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 ) 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 UpdatePlasma( ByVal Pal As GFXBuffer Pointer,_
ByVal ScreenBuffer As GFXBuffer Pointer,_
ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer )
Dim As Integer x,y,d,f
For y = 0 To ScreenBuffer->Height-1
d = cosine( y + wave2 ) + cosine( y + wave3 )
For x = 0 To ScreenBuffer->WWidth-1
f = cosine( x + wave1 ) + cosine( x + y ) + d and 255
ScreenBuffer->Pixels [ x+y*ScreenBuffer->WWidth ]=Pal->Pixels[ f and 255 ]
Next
Next
wave1 = wave1 + Val1
If wave1 >= ScreenBuffer->WWidth-1 Then wave1 = wave1 - ScreenBuffer->WWidth
wave2 = wave2 + Val2
If wave2 >= ScreenBuffer->WWidth-1 Then wave2 = wave2 - ScreenBuffer->WWidth
wave3 = wave3 + Val3
If wave3 >= ScreenBuffer->WWidth-1 Then wave3 = wave3 - ScreenBuffer->WWidth
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
Sub InitializeWindows()
ScreenBuffer = CreateGFXBuffer( XRES, YRES )
Image1= LoadGraphics8bit(32,32,@facer(0),@facep(0))
Image2= LoadGraphics8bit(32,32,@facer2(0),@facep2(0))
Button(0)=CreateButton( Image1,_
Image2,_
100,_
100)
Button(1)=CreateButton( Image1,_
Image2,_
280,_
32)
Palette1=CreatePalettes(1,256,16,128,0)
Dim As Integer a
For a=0 To 1499
Cosine( a ) = Cos( (( 115*PI * a ) / ScreenBuffer->WWidth )*D2R ) * 128
Next
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 hdc 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
End With
SetDIBitsToDevice( hdc,_
PosX,_
PosY,_
Source->WWidth,_
Source->Height,_
0,_
0,_
0,_
Source->Height,_
@Source->Pixels[0],_
@bmi,_
DIB_RGB_COLORS)
End Sub
Function CreatePalettes( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal Divv As Integer=360) As GFXBuffer Pointer
Dim As GFXBuffer Pointer Pal=CreateGFXBuffer(WWidth,Height)
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 ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=Callocate(Len( GfxBuffer )+Len( UInteger )*WWidth*Height)
Buffer->wwidth=WWidth
Buffer->height=Height
Buffer->pixels=Cast( UInteger Pointer, Cast( Byte Pointer, Buffer )+Len( GfxBuffer ))
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()
Function=0
Case WM_PAINT
hDC = BeginPaint( hWnd, @SBuffer )
UpdatePlasma( Palette1, ScreenBuffer, 2, 4, 2 )
DrawGFXBuffer( hdc, ScreenBuffer, 0, 0 )
For a=0 To MAXBUTTONS-1
DrawButton( hdc, Button(a) )
Next
EndPaint( hWnd, @SBuffer )
Function=0
case WM_LBUTTONDOWN
'If Button(0)->State=1 'Then sleep(200)
Case WM_MOUSEMOVE
MouseX = LoWord(lParam)' and &Hffff
MouseY = HiWord(lParam)' shr 16
For a=0 To MAXBUTTONS-1
If (PtInRegion(Button(a)->Region, MouseX, MouseY) <> 0) then
Button(a)->State=1
InvalidateRect(hWnd, @Button(a)->Rect, FALSE)
Else
Button(a)->State=0
InvalidateRect(hWnd, @Button(a)->Rect, FALSE)
End if
Next
Case WM_KEYDOWN
Select Case LoByte( wParam )
Case VK_ESCAPE
PostMessage( hWnd, WM_CLOSE, 0, 0 )
Function=0
End Select
Case WM_DESTROY
PostQuitMessage( 0 )
Function=0
End Select
Function=DefWindowProc( hWnd, message, wParam, lParam )
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
Function = 0
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 = GetStockObject( BLACK_BRUSH )
.lpszMenuName = null
.lpszClassName = StrPtr( APPNAME )
end with
If( RegisterClass( @wClass ) = False ) Then
Exit Function
End If
hWnd = CreateWindowEx( 0,_
APPNAME,_
APPNAME,_
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT,_
CW_USEDEFAULT,_
XRES,_
YRES,_
null,_
null,_
hInstance,_
null )
ShowWindow ( hWnd, iCmdShow )
UpdateWindow( hWnd )
While ( GetMessage( @wMsg, null, 0, 0 ) <> False )
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Wend
Function = wMsg.wParam
End Function
Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=CreateGFXBuffer( WWidth, Height )
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
-
Clyde,
Sorry I can't help! but I do like what you are doing here - very interesting.
DrewPee
-
Hmm, that crunches to about 9kb with UPX there Clyde, that's pretty small :)
Thanks for posting what you have done so far, the code is nicely set out too.
It might be nice to get an example of this into the resources section of this web site if you like :)
K+ anyway. Thanks for sharing what you've learned.
-
Cheers dudess, no problem. It would make for a pretty cool read for people who want to make a music player, or could even create a mini keyboard synthesizer.
What Im stuck with now is in getting the plasma ( and any other effects ) to actually move; for some reason it is staying static. Then I'll be asking some more questions once thats sorted.
Many humble thanks,
Clyde.
-
You need to ask yourself
When does the plasma get updated?
Answer is in WM_PAINT.
Then, when does WM_PAINT get called?
When the window needs painting because it maxmised, moved, resized, something uncovered it, or you invalidated an area of it using InvalidateRect.
Obviously none of those things happen regularly so nothing gets updated.
What you want is for the whole window to get invalidated regularly so that WM_PAINT gets called regularly.
We can do that with a timer. Try adding this case in the WndProc:
case WM_TIMER
InvalidateRect(hWnd, NULL, False)
Then, just after you call UpdateWindow in WinMain,
SetTimer(hWnd,1,1000/60,NULL)
http://msdn.microsoft.com/en-us/library/ms644906.aspx (http://msdn.microsoft.com/en-us/library/ms644906.aspx)
That will trigger a WM_TIMER message every 1000/60ms (60Hz) which will, in turn, cause a WM_PAINT message to happen, which will, in turn, cause the plasma to update.
You should probably now remove the InvalidateRgn stuff you put in the button drawing - these also cause WM_PAINT messages to happen and you won't want them now.
Jim
-
Jim your a diamond, cheers fella.
When you say remove the invalidateRgn stuff, I think your meaning this in Case WM_MouseMove, 'InvalidateRect(hWnd, @Button(a)->Rect, FALSE).
Or are you meaning elsewhere, and what exactly please dude?
I have also noticed that the 2 buttons flicker now and again ( this happened previously too ). Dont quite know whats a foot with that?
Cheers and huge thanks,
Clyde.
-
Clyde, to avoid this flicker problem you need to either draw your plasma effect and buttons in one go or "slice" your window into rectangles that you want to update.
As you can check, I did this in Camouflage music disk, for example update buttons rectangle when mouse is over it, spectrum window have it's own update region too.
My advise for you is to try something more simpler to start, as you need to understand basics about winapi coding, one good idea is to download "win32 programmer's reference (http://www.phatcode.net/downloads.php?id=238&action=get&file=win32hlp.zip)"
-
Cheers Rbz dude :D So I've got to think Rectangles.
Obviously this is early days, and you wouldnt really want buttons ontop of the visual fx window.
Muchos Gracias,
Clyde.
-
Another way of removing the flicker is to stop Windows repainting the background. It likes to erase the background with the default window background colour before asking you to redraw your stuff, causing flicker
Add
Case WM_ERASEBKGND
Return 1
This tells Windows that you erased the background (even though you didn't ;))
You might also want to set the background brush to null
.hbrBackground = GetStockObject( BLACK_BRUSH )
becomes
.hbrBackground = Null
I think that will eliminate all the flicker.
When you say remove the invalidateRgn stuff, I think your meaning this in Case WM_MouseMove
Yes.
is how to use a sound scheme if it is enabled on the pc
You can use PlaySound to trigger the default sfx.
http://msdn.microsoft.com/en-us/library/ms712879.aspx (http://msdn.microsoft.com/en-us/library/ms712879.aspx)
For instance
PlaySound(SND_ALIAS_SYSTEMSTART, Null, SND_ALIAS_ID)
or maybe
PlaySound(Cast(LPCTSTR,SND_ALIAS_SYSTEMSTART), Null, SND_ALIAS_ID)
There are almost certainly more constants than listed on that help page.
You can use LoadCursor and SetCursor
http://msdn.microsoft.com/en-us/library/ms940016.aspx (http://msdn.microsoft.com/en-us/library/ms940016.aspx)
to change the mouse pointer. There are dozens built in.
Jim
-
Thanks Jim dude! :D
I tried the WM_ERASEBKGRND in conjuction with .hbrBackground = Null , but im still getting flickering on the button images.
I have:
Case WM_ERASEBKGND
Return 1 '( Or Function=1 )
Just before WM_PAINT.
Cheers,
Clyde.
-
Time to re-post the source now you've worked on it some more :)
Jim
-
Ok dude, here we go:
'
' Clyde Gets Into Windows.
' October 2008
' Note: You will need the media files found in the zip to run.
'
Option Explicit
Option Static
#Include Once "Windows.bi"
#Include Once "crt.bi"
#Include Once "media\FaceP.bas"
#Include Once "media\FaceR.bas"
#Include Once "media\Face2P.bas"
#Include Once "media\Face2R.bas"
Const As Single PI=3.14159265
Const As Single D2R=PI/180.0
Const MAXBUTTONS=2
Const XRES=640
Const YRES=480
Const APPNAME As String="Windows Framework"
Type GfxBuffer
wwidth As Integer
height As Integer
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 GfxBuffer Pointer Image1,Image2, ScreenBuffer, 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 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 )
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 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 CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As integer ) 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 ) 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 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 )
Dim bmi As BITMAPINFO
With bmi.bmiheader
.biSize = SizeOf (BITMAPINFOHEADER)
.biWidth = ScreenBuffer->WWidth
.biHeight = -ScreenBuffer->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,_
0,_
0,_
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
Sub InitializeWindows()
ScreenBuffer = CreateGFXBuffer( XRES, YRES )
Image1= LoadGraphics8bit(32,32,@facer(0),@facep(0))
Image2= LoadGraphics8bit(32,32,@facer2(0),@facep2(0))
Button(0)=CreateButton( Image1,_
Image2,_
100,_
100)
Button(1)=CreateButton( Image1,_
Image2,_
280,_
32)
Palette1=CreatePal(10,45,90)
Dim As Integer a
For a=0 To 1499
Cosine( a ) = Cos( (( 115*PI * a ) / ScreenBuffer->WWidth )*D2R ) * 128
Next
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
End With
SetDIBitsToDevice( Dest,_
PosX,_
PosY,_
Source->WWidth,_
Source->Height,_
0,_
0,_
0,_
Source->Height,_
@Source->Pixels[0],_
@bmi,_
DIB_RGB_COLORS)
End Sub
Function CreatePal( ByVal Val1 As Integer,_
ByVal Val2 As Integer,_
ByVal Val3 As Integer,_
ByVal Divv As Integer=360) 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 ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=Callocate(Len( GfxBuffer )+Len( UInteger )*WWidth*Height)
Buffer->wwidth=WWidth
Buffer->height=Height
Buffer->pixels=Cast( UInteger Pointer, Cast( Byte Pointer, Buffer )+Len( GfxBuffer ))
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()
Function=0
Case WM_TIMER
InvalidateRect(hWnd, NULL, False)
Case WM_ERASEBKGND
'Function=1
Return 1
Case WM_PAINT
hDC = BeginPaint( hWnd, @SBuffer )
UpdatePlasma( hdc, ScreenBuffer, Palette1, 2, 4, 2 )
For a=0 To MAXBUTTONS-1
DrawButton( hdc, Button(a) )
Next
EndPaint( hWnd, @SBuffer )
Function=0
case WM_LBUTTONDOWN
'If Button(0)->State=1 Then DoSomething()
Case WM_MOUSEMOVE
MouseX = LoWord(lParam)' and &Hffff
MouseY = HiWord(lParam)' shr 16
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 )
Function=0
End Select
Case WM_DESTROY
PostQuitMessage( 0 )
Function=0
End Select
Function=DefWindowProc( hWnd, message, wParam, lParam )
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
hWnd = CreateWindowEx( 0,_
APPNAME,_
APPNAME,_
WS_OVERLAPPEDWINDOW, _
CW_USEDEFAULT,_
CW_USEDEFAULT,_
XRES,_
YRES,_
null,_
null,_
hInstance,_
null )
ShowWindow ( hWnd, iCmdShow )
UpdateWindow( hWnd )
SetTimer(hWnd,0,1000/60,null)
While ( GetMessage( @wMsg, null, 0, 0 ) <> False )
TranslateMessage( @wMsg )
DispatchMessage ( @wMsg )
Wend
Function = wMsg.wParam
End Function
Function LoadGraphics8Bit( ByVal WWidth As Integer,_
ByVal Height As Integer,_
ByVal Raw As UByte Pointer,_
ByVal Palet As UByte Pointer ) As GfxBuffer Pointer
Dim As GfxBuffer Pointer Buffer=CreateGFXBuffer( WWidth, Height )
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
I have seen some people changing things to a dc and selecting objects. Dont know what thats about, or if its needed.
Cheers and very special thanks,
Clyde.
-
Nice work! that is coming together now! I will be keeping a close eye on this!
:)
-
Replace
hWnd = CreateWindowEx( 0,_
...
with
hWnd = CreateWindowEx( WS_EX_COMPOSITED,_
...
Jim
-
Thanks Jim thats smashing :)
-
Right now it's time to get going with applying a skin.
I can design the image to be used as the skin; obviously without any buttons on. But I need help in applying and using the skin. I think i might need a region for the screen to feature any visuals. Maybe the actual skin itself ???
Also the skin image will be the same format as before a raw and pal set of byte arrays.
Im also trying to find info on how, to make the mouse cursor change to a hand when there something that can be pressed, and display a tool tip.
Any help would be wonderfull and thankyou - mostly in the adding a skin department! ;)
Clyde.
-
sub SetMyClipRegion(ByVal hWnd As HWND)
dim wr as RECT
GetWindowRect(hWnd, @wr)
dim w as integer
dim h as integer
dim r as integer
w = wr.Right - wr.Left
h = wr.Bottom - wr.Top
if w > h then
r = h
else
r = w
end if
r = r / 2
dim i as integer
dim a as single
dim s as integer
dim astep as single
s = 21
astep = 2*PI/s
a = astep
dim hdc as HDC
hdc = GetDC(hWnd)
BeginPath(hdc)
MoveToEx(hdc, w/2, 0, Null)
for i = 1 to s-1
dim x as integer
dim y as integer
x = w/2+sin(a)*r
y = h/2-cos(a)*r
LineTo(hdc, x, y)
a = a + astep
next
EndPath(hdc)
dim region as HRGN
region = PathToRegion(hdc)
SetWindowRgn(hWnd, region, True)
ReleaseDC(hWnd, hdc)
end sub
Add a call to this function directly after calling ShowWindow.
There may be more efficient ways of doing this these days, but this will work for now.
Jim
-
Ok coool, a circular region ( that would also be very cool if using circular buttons ;) :)
Hows about having a proper "skinned" image?
Im in the process of making some button images, and an image for the skin ( hopefully Im calling it the proper term - Where theres an image ( sometimes with a colour mask ) that acts as a graphical way of making the window look more inviting; where buttons sit and the main visual area goes, etc, etc ) Aim is something like Rbz's - Camouflage, WinAmp / Media Player ( in now playing mode )
Cheers and thanks extremely,
Clyde.
-
Hows about having a proper "skinned" image?
You need to explain that more. You can make any region you like, just draw the outline using LineTo.
Are you saying you have a bmp with some areas colour 0 and you'd like to make them transparent if you were to draw that to a window? If so then you need to look at how to create regions for each of the 0 areas and join them together.
Jim
-
Have you ever downloaded a music disc / music player from any demo groups?
Camouflage is one that was a joint venture between Dark Bit Factory ( Roly on Music ) and Gravity ( Rbz on ingenious code ). it's available from Rbraz.com ( with source ), possibly too in the showcase
I dont know if the appropriate term is skinned; ive always called them skinnable applications.
I'll try and give a good discription. theres an image of the player and has areas where the buttons would go and the display area for visual fx / text etc. it's like a carcass / framework that everything else sits on.
Maybe I dont need to do that as a special windows thingy, and just have it as a regular image and have that drawn first. But I was under the impression that was needed for the regions to be applied ( skinned (like skinning a drum ) ) to it
-
I've seen lots of skinned apps ;) The question is, what else do you need to make this happen?
You can load the skin image - draw all the buttons on it, or leave blanks where you can print buttons over the top.
You can detect the mouse over a button, or just an area, and change the image.
You've already discovered WM_LBUTTONDOWN which will let you do the click.
You can cut out any shape you like for your window.
The only thing I can see left is that you need some way to define all the images/areas. I would do that in an .ini file using
GetPrivateProfileString to retrieve the options.
http://msdn.microsoft.com/en-us/library/ms724353(VS.85).aspx (http://msdn.microsoft.com/en-us/library/ms724353(VS.85).aspx)
Jim
-
Hi,
Here's a new update with an interface graphic. All source and media included in the attachment. Still have yet to make nicer buttons, currently using temporary ones.
My Questions / Help needed are the following ( at time of writting )
1/ The size of the window isnt big enough to support the interface graphic.
2/ I need to get rid of the windows taskbar and edges, so that the interface is the design of the window. This'll mean I also need to know how to make my own minimize and close routines, when pressing the buttons for this. At present there is one for close.
3/ I've realized that black shows up, and isnt transparent, so have added a mask colour of &HFF00FF around any edges etc that arent expected to be seen. Just incase this is needed; as the black area is used for the display screen.
4/ Often the screen display area ( for now called PlasmaBuffer aka the black area ) will flicker now and again.
Cheers and huge thanks,
Clyde
-
impressive clyde...keep going ;D
-
Thanks Hotshot.
I found a command called: SetWindowRgn(hWnd, region, True ) in Rbz's Camouflage source, and which im guessin I need to be using to set the window to the shape of the skin. also there are some bits to remove the taskbar and caption.
Im wondering if a tool is needed or available to make a WindowRegion also button regions out of the edges of images?
If there isnt would someone like to help me in creating one if I started a new topic on this ( or post in this fred )??
At the moment I will try to make it a bog standard rectangle region. Not quite sure on how to disregard the colour mask / make it show the desktop underneath.
Cheers a hugest of thanks,
Clyde.
-
Ok here's an update, now with moveable window and close button - as previously with mockup buttons. and testing skin.
Not entirely sure on what the actual style stuff does - as i've borrowed it from the Camouflage Music Disk, will need to look that up, if i can find a place with the info.
And still not sure how to make the mask colour show through the underlying desktop, also the window doesnt start initially in the middle of the screen.
-
I found a command called: SetWindowRgn(hWnd, region, True ) in Rbz's Camouflage source,
If you notice, that's the last function I call in the last snippet I posted. It sets the region I created using lines, to be the window's clip region.
If you want to make your window bigger, then change xres, yres that you pass to CreateWindow.
To get rid of all the window icons, status bars, borders, etc, change WS_OVERLAPPEDWINDOW to WS_POPUP in CreateWindow.
To get areas to show through your bitmap, create a rectangular region, then subtract away regions for the transparent colour. I'd do this by, for each scanline of the image, create a 1 pixel high region for each of the non-seethrough runs of pixels and add it to an empty region using OR. Repeat for each scanline.
also the window doesnt start initially in the middle of the screen.
In CreateWindow, you used
CW_USEDEFAULT,_
CW_USEDEFAULT,_
as the x,y position of the window. That tells Windows it can put the window wherever it wants.
Jim
-
Hiya and thankyou Jim,
I wonder if you're not too busy and would be able to show me how to actually do the following for regions please matey? As Im a littlle bit lost on it. And it would help me tremendously!! :D
To get areas to show through your bitmap, create a rectangular region, then subtract away regions for the transparent colour. I'd do this by, for each scanline of the image, create a 1 pixel high region for each of the non-seethrough runs of pixels and add it to an empty region using OR. Repeat for each scanline.
[ edit ]
I've been looking through the source code to the Camouflage Music disk ( available from Rbraz.com ), and it looks as if there is a colour that it ignores as the main image used for the skin / window region just uses full green colour of 255 for the mask (hex: 00FF00 )? Reason I put this is as I can't find anything that is used in any way to mask any images in the drawing bits with that colour.
Also tried to look for stuff on MSDN, for text that appears when the mouse pointer is over a button, but don't know what area to look in. Have been there, and also dont a search but nothing.
[ /edit ]
Mighty thanks,
Clyde.
-
To recap incase my topic was a bit of a mouthfull.
Am having difficulties with the following:
1 - Creating ( Button ) Regions with a routine that as suggested uses the scanline. And / Or any other method.
2 - Displaying the stored arrays image used for the main interface ( aka The Skin ) properlly with being able to see the desktop underneath with using a mask colour. Perhaps there is a default colour that windows automatically senses for this purpose.
Any joys anybody please dudes?
Cheers and humble thanks in advance,
Clyde.
-
They are both the same problem. I haven't had any time to work on it so if you want to work on it yourself you need to look at the windows Region API which is what we've all been looking at in the last couple of posts.
Before you look at the windows bit though, you need to build the shape which corresponds either to the solid or transparent areas of your background image (your choice, either can be made to work). You can create it like this: If you consider each scanline of your background image as a 1 pixel high rectangle, you should be able to create a bunch of rectangles which if you were to join them all together would cover your picture, minus the blank bits. So you can get each row of the sprite which is your background and work on making rects for the solid bits. The code might go like this:
for y=0 to height-1
if pixel[0][y]=background colour then
inout=0 'transparent
else
inout=1 'solid
endif
start=0
for x = 1 to width-1
if inout=1 and pixel[x][y]=transparent 'gone from solid to trans
'make a rectangle from 'start' to x, y to y+1
else if intout=0 and pixel[x][y]=solid ' gone from trans to solid
start=x
end if
next
if inout=1 then 'ended up solid, so make a rectangle to the rhs of the window
'make a rectangle from 'start' to 'width'-1, y to y+1
end if
next
If you can work on making those rectangles, then I can show you how to make a Region from them and apply it to the window.
Jim
-
Thanks heaps for that Jim dude, and I fullly understand and appreciate your busy etc.
I shall get cracking and post up the routine based around the code above, as soon as i've done it, hopefully if there's anything wrong with it you'll be able to point it out for me.
Cheers,
Clyde.
-
Ok here's the basis to the routine to make regions from an image as yet untested. All I've done is put in the rectangle stuff; looking forward to the next step of putting these to good use. As long as the routine looks ok that is?
Side Note: Im thinking this will apply for both a Window and a Button region; with a slight bit of modification (eg changing the routine name and the calls a tad ) And fingers crossed will allow for funky / non rectangular shaped designs?
Sub CreateRegionFromImage( ByVal Image As GFXBuffer Pointer, ByVal PosX As Integer, ByVal PosY As Integer )
Dim As Integer inout, start, x, y
Dim As Rect RegionRect
For y=0 To Image->Height-1
If Image->pixels[ (0+y)*Image->WWidth ]=Image->Mask Then
'
' Transparent - is that the right term for this?
'
inout=0
Else
'
' Solid.
'
inout=1
EndIf
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 +Image->PosX
.Top =x +PosX
.Right =y +PosY
.Bottom =(y+1) +PosY
End With
'
' Gone From Transparent To Solid.
'
ElseIf inout=0 And Image->pixels[ x+y*Image->WWidth ]>0 And Image->pixels[ x+y*Image->WWidth ]<>Image->Mask Then start=x
EndIf
Next
'
' Ended Up As Solid, So Make A Rectangle To The Rhs( whats that? ) Of The Window.
'
If inout=1 Then
'
' Make a rectangle from 'start' to 'width'-1, y to y+1
'
With RegionRect
.Left =Start +PosX
.Top =(Image->WWidth-1) +PosX
.Right =y +PosY
.Bottom =(y+1) +PosY
End With
End If
Next
End Sub
[ Edit ]
I think I will create a tester program using TinyPTC for quickness.
Stay tooned.
[ /Edit ]
Cheers and big thanks,
Clyde.
-
Looks hopeful! Mocking it up in PTC so you can see it is an excellent idea.
Jim
-
Cheers matey, im almost done with it.
Something isnt quite right somewhere, going by the on screen results.
-
Ok here it is; but doesnt behave properly as you'll see.
Thanks,
Clyde.
-
Why do you think it doesn't work?
You've got the tools to work it out. One hint is I forgot to change 'inout' during the loop, but that's not all of the problem.
What is the bmp you are using? There's no way to tell what the output should be from the .bas files. How do you determine the mask colour?
rhs = right hand side.
Jim
-
With the Mask Color I manually add it to the loading of the image command for the which in this case is &HFF00FF. The GFXBuffer type stores this into the field mask. ( image->mask=mask )
Cheers and thanks,
Clyde.
-
Main bug was in the rectangle routine!
'
' Regional Tester By Mr Clyde "Fuzzy Wuzzy" Radcliffe
' Image Loading & Drawing Routines (c) Gravity 2008
' Image Conversion Tools - BMP2RAW / Bin2Bas By Rbz - C0d1gos
'
Option Static
Option Explicit
#Include Once "Tinyptc_ext.bi"
#Include Once "Windows.bi"
#Include Once "crt.bi"
'#Include Once "Media\Button1R.bas"
'#Include Once "Media\Button1P.bas"
#Include Once "Media\Skin1R.bas"
#Include Once "Media\Skin1P.bas"
Const XRES=800
Const YRES=600
Type GFXBuffer
wwidth As Integer
height As Integer
mask As UInteger
pixels As UInteger pointer
End Type
Dim Shared As GFXBuffer Pointer SkinBuffer, ScreenBuffer
Declare Sub DrawGFXBuffer( ByVal Dest As GFXBuffer Pointer,_
ByVal Source As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Declare Sub DrawRegionFromImage( ByVal Dest As GFXBuffer Pointer,_
ByVal Image As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Declare Sub DrawRectangle( ByVal Dest As GFXBuffer Pointer,_
ByVal X0 As Integer,_
ByVal Y0 As Integer,_
ByVal X1 As Integer,_
ByVal Y1 As Integer )
Declare Sub InitializeTester()
Declare Sub RunTester()
Declare Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer,_
ByVal Mask As UInteger=0 ) 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
InitializeTester()
RunTester()
Sub DrawGFXBuffer( ByVal Dest As GFXBuffer Pointer,_
ByVal Source As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Dim As Integer x,y
For y=0 To Source->Height-1
For x=0 To Source->WWidth-1
Dest->Pixels[ x+y*Dest->WWidth ]=Source->Pixels[ x+y*Source->WWidth ]
Next
Next
End Sub
Sub DrawRectangle( ByVal Dest As GFXBuffer Pointer,_
ByVal X0 As Integer,_
ByVal X1 As Integer,_
ByVal Y0 As Integer,_
ByVal Y1 As Integer )
Dim As Integer x,y
Dim As Integer StartX=X0, EndX=X1-1
Dim As Integer StartY=Y0, EndY=Y1-1
If StartX<0 Then StartX=0
If EndX>=Dest->wwidth Then EndX =Dest->wwidth-1
If StartX<=EndX Then
If StartY<0 Then StartY=0
If EndY>=Dest->height Then EndY=Dest->height-1
If StartY<=EndY Then
For y=StartY To EndY
For x=StartX To EndX
*( Dest->pixels+x+y*Dest->wwidth)=&HFF
Next
Next
End if
End if
End Sub
Sub DrawRegionFromImage( ByVal Dest As GFXBuffer Pointer,_
ByVal Image As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Dim As Integer inout, start, x, y
Dim As Rect RegionRect
For y=0 To Image->height-1
If Image->pixels[ 0+y*Image->WWidth ]=Image->Mask Then
'
' Transparent - is that the right term for this?
'
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
'
DrawRectangle( ScreenBuffer, Start+PosX, x+PosX, y+PosY, (y+1)+PosY )
'With RegionRect
' .Left =StartX +Image->PosX
' .Top =x +PosX
' .Right =y +PosY
' .Bottom =(y+1) +PosY
'End With
'
' Gone From Transparent To Solid.
'
inout=0
ElseIf (inout=0) And (Image->pixels[ x+y*Image->WWidth ]<>Image->Mask) Then
Start=x
inout=1
EndIf
Next
'
' Ended Up As Solid, So Make A Rectangle To The Rhs( whats that? ) Of The Window.
'
If inout=1 Then
'
' Make a rectangle from 'start' to 'width'-1, y to y+1
'
DrawRectangle( ScreenBuffer, Start+PosX, (Image->WWidth-1)+PosX, y+PosY, (y+1)+PosY )
'With RegionRect
' .Left =Start +PosX
' .Top =(Image->WWidth-1) +PosX
' .Right =y +PosY
' .Bottom =(y+1) +PosY
'End With
End If
Next
End Sub
Sub InitializeTester()
PTC_Open( "Tester", XRES, YRES )
ScreenBuffer=CreateGFXBuffer( XRES, YRES )
SkinBuffer=LoadGraphics8Bit( 512, 256, @Skinmk1r(0), @skinmk1p(0), &HFF00FF )
End Sub
Sub RunTester()
Dim Key As String
While Key<>Chr(27)
DrawGFXBuffer ( ScreenBuffer, SkinBuffer, 0, 0 )
DrawRegionFromImage ( ScreenBuffer, SkinBuffer, 0, SkinBuffer->height )
PTC_Update @(ScreenBuffer->Pixels[0])
Key=Inkey()
Wend
End Sub
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 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
Pretty eh?
Jim
-
'
' Regional Tester By Mr Clyde "Fuzzy Wuzzy" Radcliffe
' Image Loading & Drawing Routines (c) Gravity 2008
' Image Conversion Tools - BMP2RAW / Bin2Bas By Rbz - C0d1gos
'
Option Static
Option Explicit
#Include Once "Tinyptc_ext.bi"
#Include Once "Windows.bi"
#Include Once "crt.bi"
'#Include Once "Media\Button1R.bas"
'#Include Once "Media\Button1P.bas"
#Include Once "Media\Skin1R.bas"
#Include Once "Media\Skin1P.bas"
Const XRES=800
Const YRES=600
Type GFXBuffer
wwidth As Integer
height As Integer
mask As UInteger
pixels As UInteger pointer
End Type
Dim Shared As GFXBuffer Pointer SkinBuffer, ScreenBuffer
Declare Sub DrawGFXBuffer( ByVal Dest As GFXBuffer Pointer,_
ByVal Source As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Declare function DrawRegionFromImage( ByVal Dest As GFXBuffer Pointer,_
ByVal Image As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer ) as HRGN
Declare Sub DrawRectangle( ByVal Dest As GFXBuffer Pointer,_
ByVal X0 As Integer,_
ByVal Y0 As Integer,_
ByVal X1 As Integer,_
ByVal Y1 As Integer )
Declare Sub InitializeTester()
Declare Sub RunTester()
Declare Function CreateGFXBuffer( Byval WWidth As Integer,_
Byval Height As Integer,_
ByVal Mask As UInteger=0 ) 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
InitializeTester()
RunTester()
Sub DrawGFXBuffer( ByVal Dest As GFXBuffer Pointer,_
ByVal Source As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer )
Dim As Integer x,y
For y=0 To Source->Height-1
For x=0 To Source->WWidth-1
Dest->Pixels[ x+y*Dest->WWidth ]=Source->Pixels[ x+y*Source->WWidth ]
Next
Next
End Sub
Sub DrawRectangle( ByVal Dest As GFXBuffer Pointer,_
ByVal X0 As Integer,_
ByVal X1 As Integer,_
ByVal Y0 As Integer,_
ByVal Y1 As Integer )
Dim As Integer x,y
Dim As Integer StartX=X0, EndX=X1-1
Dim As Integer StartY=Y0, EndY=Y1-1
If StartX<0 Then StartX=0
If EndX>=Dest->wwidth Then EndX =Dest->wwidth-1
If StartX<=EndX Then
If StartY<0 Then StartY=0
If EndY>=Dest->height Then EndY=Dest->height-1
If StartY<=EndY Then
For y=StartY To EndY
For x=StartX To EndX
*( Dest->pixels+x+y*Dest->wwidth)=&HFF
Next
Next
End if
End if
End Sub
Function DrawRegionFromImage( ByVal Dest As GFXBuffer Pointer,_
ByVal Image As GFXBuffer Pointer,_
ByVal PosX As Integer,_
ByVal PosY As Integer ) as HRGN
Dim As Integer inout, start, x, y
Dim As Rect RegionRect
Dim reg as HRGN
reg = CreateRectRgn(0,0,0,0)
For y=0 To Image->height-1
If Image->pixels[ 0+y*Image->WWidth ]=Image->Mask Then
'
' Transparent - is that the right term for this?
'
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
'
DrawRectangle( ScreenBuffer, Start+PosX, x+PosX, y+PosY, (y+1)+PosY )
With RegionRect
.Left =Start +PosX
.Right =X +PosX
.Top =Y +PosY
.Bottom =y+1 +PosY
End With
CombineRgn(reg,reg,CreateRectRgnIndirect(@RegionRect),RGN_OR)
'
' Gone From Transparent To Solid.
'
inout=0
ElseIf (inout=0) And (Image->pixels[ x+y*Image->WWidth ]<>Image->Mask) Then
Start=x
inout=1
EndIf
Next
'
' Ended Up As Solid, So Make A Rectangle To The Rhs( whats that? ) Of The Window.
'
If inout=1 Then
'
' Make a rectangle from 'start' to 'width'-1, y to y+1
'
DrawRectangle( ScreenBuffer, Start+PosX, (Image->WWidth-1)+PosX, y+PosY, (y+1)+PosY )
With RegionRect
.Left =Start +PosX
.Right =(Image->WWidth-1) +PosX
.Top =y +PosY
.Bottom =y+1 +PosY
End With
CombineRgn(reg,reg,CreateRectRgnIndirect(@RegionRect),RGN_OR)
End If
Next
return reg
End Function
Sub InitializeTester()
PTC_Open( "Tester", XRES, YRES )
ScreenBuffer=CreateGFXBuffer( XRES, YRES )
SkinBuffer=LoadGraphics8Bit( 512, 256, @Skinmk1r(0), @skinmk1p(0), &HFF00FF )
End Sub
Sub RunTester()
Dim Key As String
Dim win as HWND
win = ptc_getwindow()
'SetWindowLong(win, GWL_EXSTYLE, WS_EX_COMPOSITED)
'SetWindowLong(win, GWL_STYLE, WS_POPUP Or WS_VISIBLE)
SetWindowRgn(win, DrawRegionFromImage ( ScreenBuffer, SkinBuffer, 0, 0), True)
While Key<>Chr(27)
DrawGFXBuffer ( ScreenBuffer, SkinBuffer, 0, 0 )
'DrawRegionFromImage ( ScreenBuffer, SkinBuffer, 0, 0 )
PTC_Update @(ScreenBuffer->Pixels[0])
Key=Inkey()
Wend
End Sub
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 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
Here it is with the region being created and applied. If you move this code back in to your proper framework it will fix up the offsets and overlap problems.
Jim
-
Cheers Jim, and yep it does look pretty cool. Will have a play around putting this into the framework during tommorrow. Obviously I will return with questions etc, when I hit a dead end.
Hugest of thanks,
Clyde.
-
For any of those that are secretly following this, I will be back to this in a few days. Just got some stuff to deal with first at the moment.
-
Righty-o Im back in the land of windows coding again,
This time I have attempted but not very succesfully in creating a region for the window. If you run the attached source it will need you to run task manager and stop the process; as there is something a foot in the listing.
I also would like to know how to omit the mask colour from being drawn, once the region bug has been splatted.
Once this is succesfull, I will then proceed with applying the same technique to the buttons creation.
Cheers and huge thanks,
Clyde.
-
Sorry dude, I got nothing but this :
-
Yep; you wont see anything dude, as there's something wrong in the code.
btw If you use -s gui ( switch gui ), you'll stop getting the command box.
-
oh okay ;D
yeah just noticed "but not very succesfully" ><
..
Well .. I can't help then, sorry :P
-
Thanks for your interest and response dude, appreciate you having a look.
Cheers,
Clyde.
-
I can't see anything with or without the call to ApplyWindowRegion!
Jim
-
Wonder whats up with it then, any clues?
-
Well, you don't create the region until WM_CREATE but you apply it before you've pumped any messages (before DispatchMessage), which cause WM_CREATE to get called, so that'll be one part. But I would take out the region stuff altogether and try to find out why I didn't see anything!
btw, I compile with
fbc -lang deprecated file.bas
using 19b. I don't get a dos box.
Jim
-
Firstly, I feel such a fool, eagerness over took me on this one, I hadnt made Reg or in my example Region, equal anything, so was return 0. Appologies there.
However, it still doesnt show anything up, so Im think that the RectRegion values are incorrectly ordered.
Plus dont think it's going to cure the omission of the mask colour being drawn.
Thanks Humbly,
Clyde.
-
Clyde, go back to the version before you added any of the region stuff, where it worked and drew stuff, then very slowly add the new stuff, making it work step by step.
Jim
-
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
-
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.
lol i remember litterally banging my head against the wall figuring that out! i also had thought that when a return value was set for a function it would automatically jump.
-
Wow Jim dude, thats really great of you!!
Very much appreciate you doing that. Am going to look very closely at it, as im impressed about how you've done away with the mask showing, also I will remember the big tip about using Returns And Funcs equals.
Cheers and hugely appreciated,
Clyde.
-
Have noticed that around the area where the plasma effect is, theres a ( white ) flash now and again.
-
Partly to do with the plasma being slightly the wrong size and in slightly the wrong place, so it overdraws the non black part of the skin, partly some other reason I don't understand :P
Jim
-
Ah ok, ta Jim whats the solution to the plasma area?
And no, I haven't forgotten about this stuff in here, I shall be back onto this shortly.
Cheers for all your help,
Clyde.
-
Ah ok, ta Jim whats the solution to the plasma area?
??? Make it the right size. :P
The problem is the hole in the gfx overlay and the plasma are different sizes.
Jim
-
Cool, will fix that up. Then I'll return with some further questions.
-
No rush :crutches: :P