Lionheart008
15-12-2009, 21:08
topic: UI / CANVAS
hi all, dear petr,
I have done little example and ask myself what's the best way to change the pixelcolour from a bitmap from (for example) red to blue ?
thank you for your new canvas example "Canvas_BitmapGetSetTest".
my example:
' Empty GUI script created on 12-15-2009 19:28:39 by frank (ThinAIR)
Uses "console", "ui"
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
Function TBMAIN () As Long
' - Change all red pixels to blue ?
Dim s As String
Local PixelPtr As Long
Local bmp As String
Local pixelsizeX As Long
Local pixelsizeY As Long
Local i As Long
pixelsizeX = CVL(bmp,1)
pixelsizeY = CVL(bmp,5)
PixelPtr = STRPTR(bmp) + 8
For i = 1 To pixelsizeX * pixelsizeY
If @PixelPtr = BGRA(%RED) Then @PixelPtr = BGRA(%BLUE)
Incr PixelPtr
Next
Canvas_BitmapSet (bmp, pixelsizeX, pixelsizeY)
MsgBox 0, "result: " + Str$(pixelPtr), %MB_ICONINFORMATION, "test for changing pixel"
PrintL "all ok, push key to exit :)"
WaitKey
End Function
salve, frank
Petr Schreiber
15-12-2009, 22:50
Hi Frank,
what you posted seems to be fragment of PB code, not ThinBASIC one.
As the returned bits are BGR 32bit aligned, you can simply go for:
Dim w, h As Long, s As String, bgrRaw As String
s = Canvas_BitmapGet(w, h)
' -- 32 bit alignment = LONG aka 32bit integer usable for overlay
Dim Bits(w, h) As Long At STRPTR(s)
Dim x, y As Long
For x = 1 To w
For y = 1 To h
' -- Is it Red? Then make it Blue
If Bits(x, y) = RGB2BGR(255,0,0) Then Bits(x, y) = RGB2BGR(0,0,255)
Next
Next
Canvas_BitmapSet(s, w, h)
CANVAS_Redraw
Where RGB2BGR is:
Function RGB2BGR(r As Long, g As Long, b As Long) As Long
Return RGB(b,g,r)
End Function
Lionheart008
15-12-2009, 23:43
as the returned bits are BGR 32bit aligned, you can simply go for:
thanks petr, that was I was looking for! ;)
here my little modification of your little new canvas example. I like canvas!
'- franks try :)
Uses "UI"
' -- ID numbers of controls
Begin Const
%cCanvasDB = %WM_USER + 500
%bModifyBitmap
%bClose
%bMake
End Const
Type BGRA
B As Byte
G As Byte
R As Byte
A As Byte
End Type
' -- Create dialog here
FUNCTION TBMAIN()
LOCAL hDlg AS DWORD
Dialog NEW 0, "Managing canvas bitmap",-1,-1, 300, 160, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION OR _
%WS_SYSMENU Or %WS_MINIMIZEBOX, 0 To hDlg
' -- Place controls here
dim cx, cy as long
Dialog PIXELS hDlg, 257, 220 To UNITS cx, cy
Control ADD Canvas, hDlg, %cCanvasDB, "", 5, 5, cx, cy
Control ADD BUTTON, hDlg, %bModifyBitmap, "Redraw", 10+cx, 5, 50, 14, Call bModifyBitmapProc
Control ADD BUTTON, hDlg, %bClose, "Close", 10+cx, cy+5-12, 50, 14, Call bCloseProc
Control ADD BUTTON, hDlg, %bMake, "otherOne", 10+cx, cy+5-28, 50, 14, Call myproc
Dialog SHOW MODAL hDlg, Call dlgProc
END FUNCTION
' -- Callback for dialog
CALLBACK FUNCTION dlgProc()
' -- Test for messages
SELECT CASE CBMSG
Case %WM_INITDIALOG
CANVAS_Attach(CBHNDL, %cCanvasDB, %FALSE)
DrawGraphics()
Canvas_Redraw
CASE %WM_CLOSE
' -- Put code to be executed before dialog end here
END SELECT
END FUNCTION
' -- Callback for close button
CallBack Function bCloseProc()
If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
' -- Closes the dialog
DIALOG END CBHNDL
END IF
END IF
End Function
CallBack Function bModifyBitmapProc()
If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
CANVAS_Attach(CBHNDL, %cCanvasDB, %TRUE)
DrawGraphics()
Dim w, h As Long, s As String
s = Canvas_BitmapGet(w, h)
Dim Bits(w, h) As BGRA At STRPTR(s)
Dim x, y As Long
Dim grey As Byte = Rnd(128,255)
For x = 1 To w
For y = 1 To h
If Mod(y, 2) = 1 Then
Bits(x, y).B = grey
Bits(x, y).G = grey
Bits(x, y).R = grey
End If
Next
Next
Canvas_BitmapSet(s, w, h)
CANVAS_Redraw
Dialog SET TEXT CBHNDL, Format$(w)+"x"+Format$(h)+","+Str$(Len(s))+" bytes total"
End If
End If
End Function
CallBack Function myProc()
If CBMSG = %WM_COMMAND Then
If CBCTLMSG = %BN_CLICKED Then
Canvas_Attach(CBHNDL, %cCanvasDB, %TRUE)
DrawGraphics3()
DrawGraphics2()
Dim w, h As Long, s As String
s = Canvas_BitmapGet(w, h)
Dim Bits(w, h) As BGRA At STRPTR(s)
Dim x, y As Long
For x = 1 To w
For y = 1 To h
If Bits(x, y) = RGB2BGR(255,0,0) Then Bits(x, y) = RGB2BGR(0,0,255)
Next
Next
MsgBox 0, "all ok with Pixelx: " + Str$(x)
MsgBox 0, "all ok with Pixely: " + Str$(y)
Dim blue As Byte = Rnd(200,255)
For x = 1 To w
For y = 1 To h
If Mod(y, 4) = 1 Then
Bits(x, y).B = blue
Bits(x, y).G = blue
Bits(x, y).R = blue
End If
Next
Next
Canvas_BitmapSet(s, w, h)
Canvas_Redraw
End If
End If
End Function
SUB DrawGraphics()
DIM tx, ty AS LONG
tx = 100+Cos(GetTickCount/100)*10
ty = 100+Sin(GetTickCount/100)*10
CANVAS_Color RGB(128, 255, 0), RGB(0, 0, 0)
Canvas_Clear(rgb(0,0,0))
CANVAS_Scale PIXELS
Canvas_Line ((0,0), (300, 220), RGB(255,0,0))
Canvas_Line ((300,0), (0, 220), RGB(255,255,0))
Canvas_Clear(RGB(0,0,0))
Canvas_Box(tx-50,ty-50,tx,ty, 0, RGB(255, 0, 0), RGB(255,128,0),%CANVAS_FILLSTYLE_DIAGONALCROSSEDLINES )
Canvas_Redraw
END SUB
Sub DrawGraphics2()
Local k,j As Long
For k = 0 To 255
Canvas_Color RGB(128, 255, 0), RGB(0, 0, 0)
Canvas_Clear(RGB(0,0,0))
Canvas_Scale PIXELS
Canvas_Line ((0, k),(255, k), RGB(255, 10, k+50))
Next
For j = 0 To 255
Canvas_Line ((j, 0),(j, 255), RGB(j, 100, 250))
Next
Canvas_Box ((40, 40, 120, 120), 2, RGB(100,200,182),RGB(10,20,255),%CANVAS_FILLSTYLE_UPWARDDIAGONALLINES)
End Sub
Sub DrawGraphics3()
Local i,y,x, x1,x2,y1,y2,clr As Long
For y = 0 To 255
Canvas_Line ((0, y),( 255, y), RGB(0, 0, y))
Next
For i = 1 To 20
x1 = Rnd(0,x)
x2 = Rnd(0,x)
y1 = Rnd(0,y)
y2 = Rnd(0,y)
clr = Rnd(0,&HFFFF00)
Canvas_Box ((x1,y1, x2,y2),clr,RGB(100,200,182),RGB(10,20,255) )
Next
Canvas_Redraw
SLEEP 1000
End Sub
Function RGB2BGR(r As Long, g As Long, b As Long)
Return RGB(b,g,r)
End Function
good night, see you, frank