Small Bitmap Editor

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Small Bitmap Editor

Post by aurelVZAB »

Hi
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)
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

Because i am not very much used in Fb
is there a way to get window handler of this type of program ?
i tried with Window_Main = GetForegroundWindow()

but it looks that not respond ?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Small Bitmap Editor

Post by BasicCoder2 »

The actual program is very simple and I would have thought you could do it entirely using the windows api to make use of file dialogs, buttons and so on? I see examples scattered throughout this forum but no complete tutorial for using "windows.bi"

For example here is a simple example for a button written I think by dodicat,

Code: Select all

#include once "windows.bi"

sub getsize(picture as string,byref dimensionx as long,byref dimensiony as long)
    Open picture For Binary access read As #1
    Get #1, 19, dimensionx
    Get #1, 23, dimensiony
    Close #1
end sub

DIM szBitmap AS STRING  = "C:\FreeBasic\imageEditor\button.bmp"  '' path to a bitmap

dim as long w,h
getsize(szbitmap,w,h)
if w*h then print "OK" else print "Loading error":sleep:end

Dim As MSG msg
Dim Shared As HWND hWnd, edit
hWnd = CreateWindowEx( 0, "#32770", "Bitmap Button Test", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , 100, 0, 800, 600, 0, 0, 0, 0 )

edit = CreateWindowEx( 0, "BUTTON", "Button" , WS_BORDER Or WS_VISIBLE Or WS_CHILD or ANSI_CHARSET OR BS_PUSHBUTTON OR BS_BITMAP, 10 , 10 , w ,h , hWnd, 0, 0, 0 )

' // Load the bitmap and set its handle

DIM hBitmap AS HANDLE = LoadImage(0, szBitmap, IMAGE_BITMAP, w, h,  LR_LOADFROMFILE )

IF hbitmap THEN SendMessage(edit, BM_SETIMAGE, IMAGE_BITMAP, CAST(LPARAM, hbitmap))

While GetMessage( @msg, 0, 0, 0 )
   
    TranslateMessage( @msg )
    DispatchMessage( @msg )
   
    Select Case msg.hwnd
        Case hWnd
            Select Case msg.message
                Case 273 : PostQuitMessage(0)
            End Select
    End Select
   
Wend
PostQuitMessage(0)
End
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

Output widow is of course created with windows api ,it is clear for me
but hendlers of such a window are not exposed to user ,
only clue is screenres() function which i suppose resize window ..
he must runing inside some hidden message loop
or i need to look into help-documentation to see what is all this ?
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

where is documentation for such a things ?
is this somehow unknown?
What kind of window is that ?
I see that opened window is standard with i guess double-buffered graphic
hidden inside some include or built in somewhere ...?
anyone can you explain that ?
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

Ok
i look into documentation and is not possible to mix two types of progs
then i will use what is there including openfile /save file by pressing keys

I will leave it as is ,because i really spend too much time on that
maybe i will find something similar coded in C or C++ ...so as final is here :

Code: Select all

#include "fbgfx.bi"

Using FB

Dim e As EVENT
Dim As Integer x0, y0, x, y
'Dim As HWND win '<< -- handle
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, Win, 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

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 LoadImage()
    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
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
        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
    
    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)
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

Hello again

Is there a way to draw this palette rectangles and avoid load image from file?
thnx
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

..and also is there a way in fbgfx to increase font size
font is little bit smallish ?
tnx
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Small Bitmap Editor

Post by BasicCoder2 »

aurelVZAB

What kind of bitmap editor features do you want?

Yes you can make the fonts larger.
aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

hi basicCoder

i don't need anything special
in first i just want increase font size
it looks kind of small ...then i found this gfx null demo example

what a heck is screenlock ?

Is that mean that all drawing goes to backbuffer
and then is flipped by screenunlock to front buffer ?
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Small Bitmap Editor

Post by BasicCoder2 »

aurelVZAB
Posts: 666
Joined: Jul 02, 2008 14:55
Contact:

Re: Small Bitmap Editor

Post by aurelVZAB »

thanks basicCoder ..
so i have right :)
Post Reply