I hope that i don't bothering you with my programming in FB
But maybe some of you can be interested in such a simple bitmap editor
Code: Select all
#include "windows.bi"
Dim As MSG msg
Dim As HWND Window_Main, Button1, Button2
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))
'create button
'Button1 = CreateWindow("BUTTON", "Copy", WS_VISIBLE Or WS_CHILD, 60, 80, 100, 32, Window_Main, 0, 0, 0 )
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 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
upDate()
getmouse mx,my,,mb
ox = mx
oy = my
dim as integer i,j
dim as string key
do
'wmsg loop...
while PeekMessage(@msg, 0, 0, 0, 1) > 0
TranslateMessage(@msg)
DispatchMessage(@msg)
wend
Window_Main = GetForegroundWindow()
Select Case @msg
'Case Window_Main
' Select Case @msg
Case WM_CREATE
Button1 = CreateWindow("BUTTON", "Copy", WS_VISIBLE Or WS_CHILD, 10, 80, 80, 32, Window_Main, 0, 0, 0 )
'ExitProcess(0)
' End Select
End Select
'key press...
key = inkey
if ucase(key) = "S" then
' SaveImage()
end if
if ucase(key) = "L" then
' LoadImage()
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
update()
sleep 2
loop until multikey(&H01)