'
' 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
