my main program is simple bitmap editor made by basicCoder2 and work well
but i want to add few static controls to represent commands like LOAD ,SAVE currently pressing keyboard buttons
all that is fine ..so is there a way to add standard win api shape of program with this fbgfx?
i have this one full of warnings and not working...
Code: Select all
''' simple bitmap editor by basicCoder2 /mod by Aurel
#include "windows.bi"
#include "win/commctrl.bi"
#include "fbgfx.bi"
Using FB
const IDC_STATIC_1 = 2001
Dim e As EVENT
Dim As Integer x0, y0, x, y
Dim as integer static1, parent ,button1
'' global data.
dim shared instance as hmodule
dim shared h_font as HFONT
'' main code.
'instance = GetModuleHandle(null)
DIM hWin AS HWND
chdir exepath()
SCREENRES 640,480,32
color rgb(0,0,0),rgb(255,255,255) 'white paper, black ink
cls 'implements color command
'Const NULL As Any Ptr = 0
dim shared as string dirPath 'path to folder containing bitmap images
dirPath = curDir
dim shared as string images(0 to 100) 'list of bitmap images in folder
dim shared as integer MAX_IMAGES = 100
const wImage = 32 'width of Image
const hImage = 32 'height of Image
const SIZE = 12 'size of grid pixel.
const POSX = 220 'top/left position of grid on screen
const POSY = 8
dim shared as integer bmCount
dim shared as integer mx,my,ox,oy,mb 'mouse variables
dim shared as uinteger selectedColor 'current color selected
selectedColor = rgb(0,0,0)
'draw palette 1
dim shared as any ptr palette1
palette1 = imagecreate(153,96)
bload "palette1.bmp",palette1
'make Image image
dim shared as any ptr Image
Image = imagecreate(32,32,rgb(255,255,255))
'get window handler from fbgfx
SCREENCONTROL(FB.GET_WINDOW_HANDLE, CAST(INTEGER, hWin))
'create static controls
instance = GetModuleHandle(null)
'InitCommonControls
static1 = CreateWindowEx(&h00000000, "Static", "text", &h50000300, 20, 100, 64, 24, hwin, cast(hmenu, IDC_STATIC_1), instance, null)
ShowWindow(static1, SW_SHOW)
'SendMessage wnd, WM_SETFONT, cast(wparam, h_font), TRUE
'create button
'Button1 = CreateWindow("BUTTON", "Copy", WS_VISIBLE Or WS_CHILD, 60, 80, 100, 32, Win, 0, 0, 0 )
UpdateWindow(static1)
sub makeImagesList()
bmCount = 0
dim as string file
CONST attrib_archive = 32
CHDIR dirPath 'Change this to the directory you want to browse
file = dir("*", attrib_archive)
' 'get first image
if mid(file,len(file)-3,4) = ".bmp" then
images(bmCount)=file
bmCount = bmCount + 1
end if
'get the rest of the images
do
file = dir("", attrib_archive)
if mid(file,len(file)-3,4) = ".bmp" then
images(bmCount)=file
if bmCount<MAX_IMAGES then
bmCount = bmCount + 1
end if
end if
loop while file <> ""
end sub
sub upDate()
dim as uinteger r,g,b,p
screenlock
cls
'copy pixel values from Image to grid display
line (POSX-2,POSY-2)-(POSX+SIZE*wImage+2,POSY+SIZE*hImage+2),rgb(10,10,10),b
for j as integer = 0 to hImage-1
for i as integer = 0 to wImage-1
p = point(i,j,Image)
r = p shr 16 and 255
g = p shr 8 and 255
b = p and 255
line (i*SIZE+POSX+1,j*SIZE+POSY+1)-(i*SIZE+SIZE+POSX-1,j*SIZE+SIZE+POSY-1),rgb(r,g,b),bf
line (i*SIZE+POSX,j*SIZE+POSY)-(i*SIZE+SIZE+POSX,j*SIZE+SIZE+POSY),rgb(100,100,255),b
next i
next j
locate 4,8 : print "preview"
locate 32,2
print "[S] to save image"
locate 34,2
print "[L] to load image"
locate 36,2
print "[C] to clear image"
locate 38,2
print "[ESC] TO END PROGRAM"
'display Image
line (4,4)-(37,37),rgb(10,10,10),b
line (2,2)-(39,39),rgb(10,10,10),b
put (5,5),Image,pset
put (8,360),palette1,trans
line (8,360)-(8+152,360+95),rgb(0,0,255),b
'draw select color
line (170,416)-(170+30,416+30),selectedColor,bf
line (170,416)-(170+30,416+30),rgb(0,0,0),b
screenunlock
end sub
sub SaveImage()
cls
locate 2,2
dim as string fileName
INPUT "ENTER Image FILE NAME:";fileName
if right(fileName,4)<>".bmp" then
fileName = fileName + ".bmp"
end if
bsave fileName,Image
end sub
sub LoadImageFB()
cls
dim as string fileName
makeImagesList()
'print list of images
locate 1,1
for i as integer = 0 to bmCount-1
print images(i)
next i
print
INPUT "ENTER Image FILE NAME:";fileName
if right(fileName,4)<>".bmp" then
fileName = fileName + ".bmp"
end if
bload fileName,Image
'creturn 1
end sub
upDate()
getmouse mx,my,,mb
ox = mx
oy = my
dim as integer i,j
dim as string key
do
'key press...
key = inkey
if ucase(key) = "S" then
SaveImage()
end if
if ucase(key) = "L" then
LoadImageFB()
end if
if ucase(key) = "C" then
line Image,(0,0)-(wImage,hImage),rgb(255,255,255),bf
upDate()
end if
getmouse mx,my,,mb
'over drawing area?
if mx>POSX and mx<POSX+wImage*SIZE+SIZE-1 and my>POSY and my<POSY+hImage*SIZE+SIZE-1 then
if mb = 1 then
pset Image,((mx-POSX)\SIZE,(my-POSY)\SIZE),selectedColor
ox = mx
oy = my
update()
while mb=1
getmouse mx,my,,mb
if ox<>mx or oy<>my then
line Image,((mx-POSX)\SIZE,(my-POSY)\SIZE)-((ox-POSX)\SIZE,(oy-POSY)\SIZE),selectedColor
upDate()
ox = mx
oy = my
end if
sleep 2
wend
end if
end if
'is mouse over palette?
if mx>8 and mx<152 and my>360 and my<360+95 then
if mb=1 then
selectedColor = point(mx,my)
end if
end if
If (ScreenEvent(@e)) Then
Select Case e.Type
'' user pressed the mouse button
'Case EVENT_MOUSE_BUTTON_PRESS
' If (shakes = 0) Then
'' set to do 20 shakes
' shakes = 20
'' find current window coordinates to shake around
' ScreenControl GET_WINDOW_POS, x0, y0
'End If
'' user closed the window or pressed a key
Case EVENT_WINDOW_CLOSE ', EVENT_KEY_PRESS
'' exit to end of program
Exit Do
End Select
End If
update()
sleep 2
loop until multikey(&H01)