Picto-Font_V9

User projects written in or related to FreeBASIC.
albert
Posts: 4608
Joined: Sep 28, 2006 2:41
Location: California, USA

Picto-Font_V9

Postby albert » Feb 08, 2019 21:54

Here's a new version of Picto-Font..It's at version 9 now...

It fixes the problem with "Clear Glyph" resetting the brush size to 0 , and color to white.
Now it leaves all the variables alone when you clear the screen.

It still can't load BMP's , but can save the input or output as a bmp..

Code: Select all

#define WIN_INCLUDEALL
#include once "windows.bi"
#include once "win\commdlg.bi"
#include "fbgfx.bi"

const MENUID_BASE      = 100
enum MENUID_ENUM
    MENUID_FILE_CLEAR  = MENUID_BASE
    MENUID_FILE_OPEN
    MENUID_FILE_SAVE
    MENUID_FILE_SAVE_AS_BMP
    MENUID_FILE_SAVE_INPUT_AS_BMP
    MENUID_FILE_EXIT
'===============================================================================
    MENUID_BRUSH_SIZE_0_ZERO
    MENUID_BRUSH_SIZE_0_1
    MENUID_BRUSH_SIZE_0_2
    MENUID_BRUSH_SIZE_0_3
    MENUID_BRUSH_SIZE_0_4
    MENUID_BRUSH_SIZE_0_5
    MENUID_BRUSH_SIZE_0_6
    MENUID_BRUSH_SIZE_0_7
    MENUID_BRUSH_SIZE_0_8
    MENUID_BRUSH_SIZE_0_9
'===============================================================================
    MENUID_BRUSH_SIZE_ZERO_0
    MENUID_BRUSH_SIZE_1_0
    MENUID_BRUSH_SIZE_2_0
    MENUID_BRUSH_SIZE_3_0
    MENUID_BRUSH_SIZE_4_0
    MENUID_BRUSH_SIZE_5_0
    MENUID_BRUSH_SIZE_6_0
    MENUID_BRUSH_SIZE_7_0
    MENUID_BRUSH_SIZE_8_0
    MENUID_BRUSH_SIZE_9_0
'===============================================================================
    MENUID_GLYPH_X_4
    MENUID_GLYPH_X_8
    MENUID_GLYPH_X_10
    MENUID_GLYPH_X_12
    MENUID_GLYPH_X_14
    MENUID_GLYPH_X_16
    MENUID_GLYPH_X_18
    MENUID_GLYPH_X_20
    MENUID_GLYPH_X_22
    MENUID_GLYPH_X_24
    MENUID_GLYPH_X_26
    MENUID_GLYPH_X_28
    MENUID_GLYPH_X_30
    MENUID_GLYPH_X_32
    MENUID_GLYPH_X_48
    MENUID_GLYPH_X_64
'===============================================================================
    MENUID_GLYPH_Y_4
    MENUID_GLYPH_Y_8
    MENUID_GLYPH_Y_10
    MENUID_GLYPH_Y_12
    MENUID_GLYPH_Y_14
    MENUID_GLYPH_Y_16
    MENUID_GLYPH_Y_18
    MENUID_GLYPH_Y_20
    MENUID_GLYPH_Y_22
    MENUID_GLYPH_Y_24
    MENUID_GLYPH_Y_26
    MENUID_GLYPH_Y_28
    MENUID_GLYPH_Y_30
    MENUID_GLYPH_Y_32
    MENUID_GLYPH_Y_48
    MENUID_GLYPH_Y_64
'===============================================================================
    MENUID_RATIO_4
    MENUID_RATIO_6
    MENUID_RATIO_8
    MENUID_RATIO_10
'===============================================================================
    MENUID_COLOR_BLACK
    MENUID_COLOR_BROWN
    MENUID_COLOR_RED
    MENUID_COLOR_ORANGE
    MENUID_COLOR_YELLOW
    MENUID_COLOR_GREEN
    MENUID_COLOR_BLUE
    MENUID_COLOR_VIOLET
    MENUID_COLOR_WHITE
    MENUID_COLOR_CUSTOM
'===============================================================================
    MENUID_HELP_ABOUT
    MAXMENUS
end enum
'===============================================================================
'setup menus
'===============================================================================
type TMENU : hnd as HMENU : end type
dim shared submenuTB(0 to MAXMENUS) as TMENU
dim shared as uinteger menuid

'===============================================================================
'===============================================================================
'variables
'===============================================================================
'===============================================================================
'===============================================================================
dim shared as integer MouseDown
dim shared as integer  mouse_x=0
dim shared as integer  mouse_y=0
dim shared as integer  last_x =0
dim shared as integer  last_y =0

dim shared as integer  glyph_x    = 32
dim shared as integer  glyph_y    = 32
dim shared as ulongint b_color    = &H000000
dim shared as single   b_size_01  = 0
dim shared as single   b_size_10  = 0
dim shared as integer  ratio      = 10

'dim shared as ulongint bc
'dim shared as single bs_10
'dim shared as single bs_01

'drawing storage strings for saving and loading
dim shared as string glyph_size
dim shared as string xpos
dim shared as string ypos
dim shared as string brush_color
dim shared as string brush_size
dim shared as string connected

'toggle 0/1 for erasing or keeping storage strings
dim shared as integer clear_strings=0

'file name variables
dim shared as string file , ext , filename , File_type

'setup handle,messaging,structs
Dim shared hWnd As HWND
Dim shared msg as MSG
dim shared rct as RECT
dim shared pnt as PAINTSTRUCT
dim shared hDC as HDC

'setup glyph-grid objs
dim shared Glyph_Grid as HBITMAP
dim shared Glyph_Grid_Pen as HPEN
dim shared GridDC as HDC
dim shared glyphobj as HGDIOBJ
dim shared glyphpen_obj as HGDIOBJ

'setup font window objs
dim shared Font_Grid as HBITMAP
dim shared Font_Grid_Pen as HPEN
dim shared FontDC as HDC
dim shared fontobj as HGDIOBJ
dim shared fontpen_obj as HGDIOBJ

'setup output window objs
dim shared OutPut_Grid as HBITMAP
dim shared OutPut_Grid_Pen as HPEN
dim shared OutPutDC as hDC
dim shared OutPutobj as HGDIOBJ
dim shared OutPutpen_obj as HGDIOBJ

'setup help text
dim shared as string help_text
        help_text = "Picto-Font Version 8.0 Nov / 2015               " +chr(13)+chr(10)
        help_text+= "Email: Albert_Redditt@yahoo.com                 " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "A Custom Font creation program.                 " +chr(13)+chr(10)
        help_text+= "Curently there are no editors,                  " +chr(13)+chr(10)
        help_text+= "for the programs output.                        " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Click on Glyph_X_Size And Glyph_Y_Size          " +chr(13)+chr(10)
        help_text+= "and select a grid size.                         " +Chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Click on Ratio to selcet a drawing zoom ratio.  " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Click on File CLEAR_GLYPH to clear the grid.    " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Right click somewhere on the picture to set     " +chr(13)+chr(10)
        help_text+= "the initial X/Y position.                       " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Left Click to connect the two points.           " +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "Hold down a Button while moving to do FreeStyle." +chr(13)+chr(10)
        help_text+= "                                                " +chr(13)+chr(10)
        help_text+= "The console screen will display the Bytes used so far."+chr(13)+chr(10)

'===============================================================================
'===============================================================================
'declare subs and functions
'===============================================================================
'===============================================================================
declare sub menu_separator( byval submenu as integer )
declare sub menu_append( byval submenu as integer, byval id as integer, byref title as string, byval flags as integer = 0 )
declare sub menu_insert( byval hmenu as HMENU, byval submenu as integer, byref title as string, byval flags as integer = 0 )
declare sub init_menus( byval hWnd as HWND )

declare sub getfilename()

declare Sub Load_Font(byval hWnd as HWND , byval rct as RECT)

declare sub Create_Glyph_Grid_And_Pen(byval hWnd as HWND)
declare sub Make_Grid(byval hWnd as HWND)
declare sub Delete_Glyph_Grid_And_Pen(byval hWnd as HWND)

declare Sub Create_Font_Grid_And_Pen(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)
declare sub Delete_Font_Grid_And_Pen(byval hWnd as HWND)

declare Sub Create_Output_Grid_And_Pen(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)
declare sub Delete_OutPut_Grid_And_Pen(byval hWnd as HWND)

declare sub Resize_Grids(byval hWnd as HWND)
declare Sub Select_Pens(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)

declare sub Mouse_Update(byval hWnd as HWND , byval mouse as string   , byval mouse_x as integer , byval mouse_y as integer )
declare sub Draw_Mouse(byval hWnd as HWND,byval mouse_x as integer,byval mouse_y as integer,byval last_x as integer,byval last_y as integer)

declare sub Bit_blt(byval hWnd as HWND)
declare sub Update(BYVAL hWnd as HWND , BYVal rct as RECT)
declare Sub ReDraw(byval hWnd as HWND , byval rct as RECT)
'===============================================================================
declare function WndProc ( byval hWnd    as HWND   , _
                           byval message as UINT   , _
                           byval wParam  as WPARAM , _
                           byval lParam  as LPARAM ) as LRESULT
'===============================================================================
declare function WinMain ( byval hInstance as HINSTANCE     , _
                           byval hPrevInstance as HINSTANCE , _
                           byref szCmdLine as string        , _
                           byval iCmdShow as integer ) as integer
end WinMain( GetModuleHandle( null ), null, Command, SW_NORMAL )
'===============================================================================
'===============================================================================
'subs and functions below here
'===============================================================================
'===============================================================================
sub Create_Glyph_Grid_And_Pen(byval hWnd as HWND)
    dim hdc as HDC
    Glyph_Grid     = CreateCompatibleBitmap(GetDC(hWnd) , glyph_x*ratio , glyph_y*ratio )
    Glyph_Grid_Pen = CreatePen(PS_SOLID , 1 ,  &h00cf0000 )
    GridDC         = CreateCompatibleDC( hDC )
   Dim As RECT Glyph_Grid_Rect = ( 0 , 0 , glyph_x*ratio , glyph_y*ratio )
   SelectObject GridDC , Glyph_Grid
   FillRect .GridDC , @Glyph_Grid_Rect , null
end sub
'===============================================================================
'===============================================================================
sub Delete_Glyph_Grid_And_Pen(byval hWnd as HWND)
    dim hdc as HDC
    SelectObject( GridDC, glyphobj )
    SelectObject( GridDC, glyphpen_obj )
    DeleteObject( Glyph_Grid )
    DeleteObject( Glyph_Grid_Pen )
    DeleteDC( GridDC )
end sub
'===============================================================================
'===============================================================================
sub Make_Grid(byval hWnd as HWND)
    dim hdc as HDC
    glyphobj     = SelectObject( GridDC, Glyph_Grid     )
    glyphpen_obj = SelectObject( GridDC, Glyph_Grid_Pen )
    for a as integer     = 0 to glyph_x*ratio step (glyph_x*ratio) / glyph_x
        for b as integer = 0 to glyph_y*ratio step (glyph_y*ratio) / glyph_y
            lineto(GridDC,a,b)
            MoveToEX(GridDC, a +(glyph_x*ratio) / glyph_x , b + (glyph_y*ratio)/glyph_y,0)
        next
    next
end sub
'===============================================================================
'===============================================================================
Sub Create_Font_Grid_And_Pen(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)
    dim hDC as HDC
    Font_Grid     = CreateCompatibleBitmap(GetDC(hWnd) , glyph_x*ratio , glyph_y*ratio )
    Font_Grid_Pen = CreatePen( PS_SOLID , sqr(glyph_x*glyph_y)*(((bs_01*.01)+(bs_10*.1))*ratio ) , bc )
    FontDC        = CreateCompatibleDC( hDC )
   Dim As RECT Font_Grid_Rect = ( 0 , 0 , glyph_x*ratio , glyph_y*ratio )
   SelectObject FontDC , Font_Grid
   FillRect .FontDC , @Font_Grid_Rect , null
   '
   fontobj       = SelectObject( FontDC, Font_Grid     )   
    fontpen_obj   = SelectObject( FontDC, Font_Grid_Pen )
end sub
'===============================================================================
'===============================================================================
sub Delete_Font_Grid_And_Pen(byval hWnd as HWND)
    dim hDC as HDC
    SelectObject( FontDC, fontobj )
    SelectObject( FontDC, fontpen_obj )
    DeleteObject( Font_Grid )
    DeleteObject( Font_Grid_Pen )
    DeleteDC( FontDC )
end sub
'===============================================================================
'===============================================================================
Sub Create_Output_Grid_And_Pen(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)
    dim hDC as HDC
    OutPut_Grid     = CreateCompatibleBitmap(GetDC(hWnd), glyph_x , glyph_y )
    OutPut_Grid_Pen = CreatePen(PS_SOLID,sqr(glyph_x*glyph_y)*(((bs_01*.01)+(bs_10*.1))*1 ),bc)
    OutPutDC        = CreateCompatibleDC(HDC)
   Dim As RECT OutPut_Grid_Rect = ( 0 , 0 , glyph_x*ratio , glyph_y*ratio )
   SelectObject OutPutDC , OutPut_Grid
   FillRect .OutPutDC , @OutPut_Grid_Rect , null
    '
   outputobj       = SelectObject(OutPutDC , OutPut_Grid     )
    outputpen_obj   = SelectObject(OutPutDC , OutPut_Grid_Pen )
end sub
'===============================================================================
'===============================================================================
sub Delete_Output_Grid_And_Pen(byval hWnd as HWND)
    dim hDC as HDC
    SelectObject( OutPutDC, outputobj )
    SelectObject( OutPutDC, outputpen_obj )
    DeleteObject( OutPut_Grid )
    DeleteObject( OutPut_Grid_Pen )
    DeleteDC( OutPutDC )
end sub
'===============================================================================
'===============================================================================
sub Resize_Grids(byval hWnd as HWND)
    Delete_Glyph_Grid_And_Pen( hWnd )
    Delete_Font_Grid_And_Pen( hWnd )
    Delete_OutPut_Grid_And_Pen( hWnd )
    Create_Glyph_Grid_And_Pen(hWnd) : Make_Grid(hWnd)
    Create_Font_Grid_And_Pen( hWnd , b_color , b_size_10 , b_size_01)
    Create_OutPut_Grid_And_Pen( hWnd , b_color , b_size_10 , b_size_01)
    ReDraw(hWnd,rct)
end sub
'===============================================================================
'===============================================================================
Sub Select_Pens(byval hWnd as HWND , byref bc as ulongint , byref bs_10 as single , byref bs_01 as single)
    Font_Grid_Pen   = CreatePen( PS_SOLID , sqr(glyph_x*glyph_y)*(((bs_01*.01)+(bs_10*.1))*ratio ) , bc )
    fontpen_obj     = SelectObject( FontDC, Font_Grid_Pen )
    OutPut_Grid_Pen = CreatePen( PS_SOLID , sqr(glyph_x*glyph_y)*(((bs_01*.01)+(bs_10*.1))*1     ) , bc )
    outputpen_obj   = SelectObject( OutputDC, OutPut_Grid_Pen )
end sub
'===============================================================================
'===============================================================================
'mouse stuff below here
'===============================================================================
'===============================================================================
sub Mouse_Update(byval hWnd as HWND , byval mouse as string , byval mouse_x as integer , byval mouse_y as integer )
   
    if mouse_x < 0 or mouse_x > (glyph_x*ratio) then return
    if mouse_y < 0 or mouse_y > (glyph_y*ratio) then return
   
    select case mouse
        case "l_down" : MouseDown=1
        case "l_up"   : MouseDown=0
        Case "r_down" : MouseDown=1 :last_x=mouse_x : last_y=mouse_y
        case "r_up"   : MouseDown=0 :last_x=mouse_x : last_y=mouse_y
        Case "move"   : if MouseDown=0 then return
    end select
   
    if MouseDown=1 then
        glyph_size=right("00"  + str(glyph_x),2) + right("00"+str(glyph_y),2)
        xpos+ =    right("000" + str(int(100/((glyph_x*ratio/(mouse_x+1))))),3)
        ypos+ =    right("000" + str(int(100/((glyph_y*ratio/(mouse_y+1))))),3)
        brush_color+= right("00000000" + str(b_color),8)
        brush_size += right("0" + str(b_size_10),1) + right("0" + str(b_size_01),1)
       
        if mouse_x<>last_x or mouse_y<>last_y then
            connected+="1"
        else
            connected+="0"
        end if
       
        color 14
        print string(80,"=");
        color 7
        print "Glyph Size   = " ; glyph_size
        print "X Positions  = " ; xpos
        print "Y positions  = " ; ypos
        print "Brush Colors = " ; brush_color
        print "Brush Sizes  = " ; brush_size
        print "Draw To      = " ; connected
        print "Bytes For CHR= " ; len(glyph_size)+len(xpos)+len(ypos)+len(brush_color)+len(brush_size)+len(connected)
        color 14
        print string(80,"=")
        color 7
       
        Draw_Mouse(hWnd, mouse_x , mouse_y, last_x ,last_y)
        'Bit_blt(hWnd)
       
        last_x=mouse_x
        last_y=mouse_y
       
        if mouse="move" then UpDate(hWnd,rct)
   
    end if
end sub
'===============================================================================
'===============================================================================
sub Draw_Mouse(byval hWnd as HWND,byval mouse_x as integer,byval mouse_y as integer,byval last_x as integer,byval last_y as integer)
    hDC = BeginPaint( hWnd, @pnt )
        if mouse_x<>0 and mouse_y<>0 then
            Select_Pens(hWnd,b_color,b_size_10,b_size_01)
            'draw the line with the font_pen
            MoveToEx(FontDC , ( last_x)-1 , ( last_y)-1 , 0)
              LineTo(FontDC , (mouse_x)-1 , (mouse_y)-1)
            'draw the line of the output
            MoveToEx(OutputDC , ( last_x/ratio)-1 , ( last_y/ratio)-1 , 0)
              LineTo(OutputDC , (mouse_x/ratio)-1 , (mouse_y/ratio)-1)
        end if
    EndPaint( hWnd, @pnt )
end sub
'===============================================================================
'===============================================================================
'BIT BLT and update below here
'===============================================================================
'===============================================================================
sub Bit_blt(byval hWnd as HWND)
    dim hDC as HDC
    hDC = BeginPaint( hWnd, @pnt )
        'Transfer the GRID
        BitBlt(hDC , 0 , 0 , glyph_x*ratio , glyph_y*ratio , GridDC , 0 , 0 , SRCCOPY)
        'Transfer the FONT
        BitBlt(hDC , 0 , 0 , glyph_x*ratio , glyph_y*ratio , FontDc , 0 , 0 , SRCAND)
        'Transfer the OUTPUT
        BitBlt(hDC ,(glyph_x*ratio)+60, 0  , glyph_x  , glyph_y    , OutputDC , 0, 0 , SRCCOPY)
    EndPaint( hWnd, @pnt )
end sub
'===============================================================================
'===============================================================================
sub Update(BYVAL hWnd as HWND , BYVal rct as RECT)
    InvalidateRect( hwnd, 0, TRUE )
    UpdateWindow(hWnd)
end sub
'===============================================================================
'===============================================================================
'ReDraw() goes through strorage strings and replots the character.
'===============================================================================
'===============================================================================
Sub ReDraw(byval hWnd as HWND , byval rct as RECT)
    dim hDC as HDC
    dim as ulongint count_xy
    dim as ulongint count_color
    dim as ulongint count_size
    dim as ulongint count_connected
    dim as ulongint connect
    dim as ulongint lx , ly ,mx , my , bc
    dim as single bs_10 , bs_01
   
    count_xy        =1
    count_color     =1
    count_size      =1
    count_connected =2
    do
        lx  =  (val(mid( xpos       ,count_xy     +0,3))/100) * (glyph_x*ratio)
        ly  =  (val(mid( ypos       ,count_xy     +0,3))/100) * (glyph_y*ratio)
        mx  =  (val(mid( xpos       ,count_xy     +3,3))/100) * (glyph_x*ratio)
        my  =  (val(mid( ypos       ,count_xy     +3,3))/100) * (glyph_y*ratio)
        bc =valulng(mid( brush_color,count_color   , 8))
        bs_10 = val(mid( brush_size ,count_size   +0,1))
        bs_01 = val(mid( brush_size ,count_size   +1,1))
        connect=val(mid( connected  ,count_connected,1))
       
        Select_Pens(hWnd,bc,bs_10,bs_01)
       
        hDC = BeginPaint( hWnd, @pnt )
            if connect=1 then 'two points are connected   
                MoveToEx(FontDC , (lx)-1 , (ly)-1 , 0)
                  LineTo(FontDC , (mx)-1 , (my)-1)
               
                MoveToEx(OutPutDC , (lx/ratio)-1 , (ly/ratio)-1 , 0)
                  LineTo(OutPutDC , (mx/ratio)-1 , (my/ratio)-1)
            else ' two points are not connected
                MoveToEx(FontDC , (lx)-1 , (ly)-1 , 0)
                  LineTo(FontDC , (lx)-1 , (ly)-1)
               
                MoveToEx(OutPutDC , (lx/ratio)-1 , (ly/ratio)-1 , 0)
                  LineTo(OutPutDC , (lx/ratio)-1 , (ly/ratio)-1)
            end if
        EndPaint( hWnd, @pnt )
       
        count_xy        +=3
        count_color     +=8
        count_size      +=2
        count_connected +=1
       
    loop until count_size>=len(brush_size)
   
    last_x  = lx
    last_y  = ly
    mouse_x = mx
    mouse_y = my
   
    Update(hWnd,rct)
end sub
'===============================================================================
'===============================================================================
'File stuff below here
'===============================================================================
'===============================================================================
Sub Load_Font(byval hWnd as HWND , byval rct as RECT)
    file = ""
    file_type="pft"
    getfilename()
   
    if file <> "" then
        open file for input as #1
            line input #1,glyph_size
            line input #1,xpos
            line input #1,ypos
            line input #1,brush_color
            line input #1,brush_size
            line input #1,connected
        close #1
       
        if glyph_x and glyph_y = 0 then
            glyph_x=val( left(glyph_size,2))
            glyph_y=val(right(glyph_size,2))
        end if
   
        print "Glyph Size   = " ; glyph_size
        print "X Positions  = " ; xpos
        print "Y positions  = " ; ypos
        print "Brush Colors = " ; brush_color
        print "Brush Sizes  = " ; brush_size
        print "Draw To      = " ; connected
        print "Bytes For CHR= " ; len(glyph_size)+len(xpos)+len(ypos)+len(brush_color)+len(brush_size)+len(connected)
        print string(78,"=")
   
        Resize_Grids(hWnd)
    end if
end sub
'===============================================================================
'===============================================================================
'wndProcess
'===============================================================================
'===============================================================================
function WndProc ( byval hWnd as HWND, _
                   byval message as UINT, _
                   byval wParam as WPARAM, _
                   byval lParam as LPARAM ) as LRESULT

    function=0
   
    mouse_x = LoWord(LParam)
    mouse_y = HiWord(LParam)
   
   
    select case( message )
        '=======================================================================
        case WM_CREATE
            init_menus(hWnd)
            Resize_Grids(hWnd)
        '=======================================================================
        case WM_PAINT
            bit_blt(hWnd)
        '=======================================================================
        case WM_CLOSE
            Delete_Glyph_Grid_And_Pen( hWnd )
            Delete_Font_Grid_And_Pen( hWnd )
            Delete_OutPut_Grid_And_Pen( hWnd )
            DestroyWindow( hWnd )
        '=======================================================================
        case WM_DESTROY
            Delete_Glyph_Grid_And_Pen( hWnd )
            Delete_Font_Grid_And_Pen( hWnd )
            Delete_OutPut_Grid_And_Pen( hWnd )
            PostQuitMessage( 0 )
        '=======================================================================
        Case WM_LBUTTONDOWN : Mouse_Update(hWnd , "l_down" , mouse_x , mouse_y ) : UpDate(hWnd,rct)
        Case WM_LBUTTONUP   : Mouse_Update(hWnd , "l_up"   , mouse_x , mouse_y ) : UpDate(hWnd,rct)
        Case WM_RBUTTONDOWN : Mouse_Update(hWnd , "r_down" , mouse_x , mouse_y ) : UpDate(hWnd,rct)
        Case WM_RBUTTONUP   : Mouse_Update(hWnd , "r_up"   , mouse_x , mouse_y ) : UpDate(hWnd,rct)
        Case WM_MOUSEMOVE   : Mouse_Update(hWnd , "move"   , mouse_x , mouse_y )
        '=======================================================================
        case WM_COMMAND
            select case loword( wParam )
                '===================================================================
                case MENUID_FILE_CLEAR
                    'reset variables to default
                    glyph_x = glyph_x
                    glyph_y = glyph_y
                    mouse_x=0 : mouse_y=0
                    last_x =0 : last_y =0
                    'clear the monitor output
                    cls
                    'zero our character storage strings
                    glyph_size=""
                    xpos=""
                    ypos=""
                    brush_color=""
                    brush_size=""
                    connected=""
                    'rebuild the glyphs
                    Resize_Grids(hWnd)
                    UpDate(hWnd,rct)
                '===============================================================
                case MENUID_FILE_OPEN : cls : Load_Font(hWnd,rct)
                '===============================================================
                case MENUID_FILE_SAVE
                    file = ""
                    file_type="pft"
                    getfilename()
                    if file <> "" then
                        open file for output as #1
                        print #1,glyph_size
                        print #1,xpos
                        print #1,ypos
                        print #1,brush_color
                        print #1,brush_size
                        print #1,connected
                        close #1
                    end if
                '===============================================================
                case MENUID_FILE_SAVE_AS_BMP
                    file = ""
                    file_type="bmp"
                    getfilename()
                   
                    Dim As Any Ptr MYIMG
                    Dim As hDC MYDC
                    Dim As HBitmap MYBMP
                    Dim As BITMAPINFOHEADER MYBMPINFO
                   
                    Dim As Integer sx, sy
                    Screenres 128,128,32
                    'Screeninfo sx, sy
                    sx = glyph_x
                    sy = glyph_y
                    MYIMG = ImageCreate(sx, sy)
                    'TMPWND = GetDesktopWindow()
                    'GetClientRect(TMPWND, @WNDRECT)
                    'WNDDC = GetDC(TMPWND)
                    MYDC = CreateCompatibleDC(OutPutDC)
                    MYBMP = CreateCompatibleBitmap(OutputDC, sx, sy)
                    SelectObject(MYDC, MYBMP)
                   
                    With MYBMPINFO
                      .biSize = Sizeof(MYBMPINFO)
                      .biWidth = sx
                      .biHeight = -sy
                      .biPlanes = 1
                      .biBitCount = 32
                      .biCompression = BI_RGB
                      .biSizeImage = 0
                    End With
                   
                    BitBlt(MYDC, 0, 0, sx, sy, OutputDC, 0, 0, SRCCOPY)
                    GetDIBits(MYDC, MYBMP, 0, sy, MYIMG + Sizeof(FB.IMAGE), Cptr(BITMAPINFO Ptr, @MYBMPINFO), DIB_RGB_COLORS)
                    Put (0, 0), MYIMG, Pset
                    BSave( file , MYIMG)
                    screen 0
                    'ReleaseDC(TMPWND,WNDDC)
                    DeleteDC(MYDC)
                    DeleteObject(MYBMP)
                    imagedestroy(MYIMG)
                '===============================================================
                Case MENUID_FILE_SAVE_INPUT_AS_BMP
                    file = ""
                    file_type="bmp"
                    getfilename()
                   
                    Dim As Any Ptr MYIMG
                    Dim As hDC MYDC
                    Dim As HBitmap MYBMP
                    Dim As BITMAPINFOHEADER MYBMPINFO
                   
                    Dim As Integer sx, sy
                    Screenres Glyph_x*ratio , glyph_y * ratio, 32
                    'Screeninfo sx, sy
                    sx = glyph_x*ratio
                    sy = glyph_y*ratio
                    MYIMG = ImageCreate(sx, sy)
                    'TMPWND = GetDesktopWindow()
                    'GetClientRect(TMPWND, @WNDRECT)
                    'WNDDC = GetDC(TMPWND)
                    MYDC = CreateCompatibleDC(FontDC)
                    MYBMP = CreateCompatibleBitmap(FontDC, sx, sy)
                    SelectObject(MYDC, MYBMP)
                   
                    With MYBMPINFO
                      .biSize = Sizeof(MYBMPINFO)
                      .biWidth = sx
                      .biHeight = -sy
                      .biPlanes = 1
                      .biBitCount = 32
                      .biCompression = BI_RGB
                      .biSizeImage = 0
                    End With
                   
                    BitBlt(MYDC, 0, 0, sx, sy, FontDC, 0, 0, SRCCOPY)
                    GetDIBits(MYDC, MYBMP, 0, sy, MYIMG + Sizeof(FB.IMAGE), Cptr(BITMAPINFO Ptr, @MYBMPINFO), DIB_RGB_COLORS)
                    Put (0, 0), MYIMG, Pset
                    BSave( file , MYIMG)
                    screen 0
                    'ReleaseDC(TMPWND,WNDDC)
                    DeleteDC(MYDC)
                    DeleteObject(MYBMP)
                    imagedestroy(MYIMG)
                   
                '===============================================================
                case MENUID_FILE_EXIT
                    Delete_Glyph_Grid_And_Pen( hWnd )
                    Delete_Font_Grid_And_Pen( hWnd )
                    Delete_OutPut_Grid_And_Pen( hWnd )
                    PostMessage( hWnd, WM_CLOSE, 0, 0 )
                '===============================================================
                '===================================================================
                'SIZES 1% to 9%
                case MENUID_BRUSH_SIZE_0_ZERO : b_size_01=0
                case MENUID_BRUSH_SIZE_0_1    : b_size_01=1
                case MENUID_BRUSH_SIZE_0_2    : b_size_01=2
                case MENUID_BRUSH_SIZE_0_3    : b_size_01=3
                case MENUID_BRUSH_SIZE_0_4    : b_size_01=4
                case MENUID_BRUSH_SIZE_0_5    : b_size_01=5
                case MENUID_BRUSH_SIZE_0_6    : b_size_01=6
                case MENUID_BRUSH_SIZE_0_7    : b_size_01=7
                case MENUID_BRUSH_SIZE_0_8    : b_size_01=8
                case MENUID_BRUSH_SIZE_0_9    : b_size_01=9
                '===================================================================
                'SIZES 10% to 90%
                case MENUID_BRUSH_SIZE_ZERO_0 : b_size_10=0
                case MENUID_BRUSH_SIZE_1_0    : b_size_10=1
                case MENUID_BRUSH_SIZE_2_0    : b_size_10=2
                case MENUID_BRUSH_SIZE_3_0    : b_size_10=3
                case MENUID_BRUSH_SIZE_4_0    : b_size_10=4
                case MENUID_BRUSH_SIZE_5_0    : b_size_10=5
                case MENUID_BRUSH_SIZE_6_0    : b_size_10=6
                case MENUID_BRUSH_SIZE_7_0    : b_size_10=7
                case MENUID_BRUSH_SIZE_8_0    : b_size_10=8
                case MENUID_BRUSH_SIZE_9_0    : b_size_10=9
                '===================================================================
                'GLYPH_X
                Case MENUID_GLYPH_X_4 : glyph_x= 4:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_8 : glyph_x= 8:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_10: glyph_x=10:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_12: glyph_x=12:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_14: glyph_x=14:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_16: glyph_x=16:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_18: glyph_x=18:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_20: glyph_x=20:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_22: glyph_x=22:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_24: glyph_x=24:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_26: glyph_x=26:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_28: glyph_x=28:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_30: glyph_x=30:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_32: glyph_x=32:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_48: glyph_x=48:Resize_Grids(hWnd)
                Case MENUID_GLYPH_X_64: glyph_x=64:Resize_Grids(hWnd)
                'GLYPH_Y
                Case MENUID_GLYPH_Y_4 : glyph_y= 4:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_8 : glyph_y= 8:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_10: glyph_y=10:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_12: glyph_y=12:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_14: glyph_y=14:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_16: glyph_y=16:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_18: glyph_y=18:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_20: glyph_y=20:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_22: glyph_y=22:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_24: glyph_y=24:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_26: glyph_y=26:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_28: glyph_y=28:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_30: glyph_y=30:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_32: glyph_y=32:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_48: glyph_y=48:Resize_Grids(hWnd)
                Case MENUID_GLYPH_Y_64: glyph_y=64:Resize_Grids(hWnd)
                '===================================================================
                'drawing glyph ratios
                case MENUID_RATIO_4 : ratio=4 : Resize_Grids(hWnd)
                case MENUID_RATIO_6 : ratio=6 : Resize_Grids(hWnd)
                case MENUID_RATIO_8 : ratio=8 : Resize_Grids(hWnd)
                case MENUID_RATIO_10: ratio=10: Resize_Grids(hWnd)
                '===================================================================
                'COLORS
                case MENUID_COLOR_BLACK : b_color=0       
                case MENUID_COLOR_BROWN : b_color=&H0b4080
                case MENUID_COLOR_RED   : b_color=&h0000aa
                case MENUID_COLOR_ORANGE: b_color=&H0055ff
                case MENUID_COLOR_YELLOW: b_color=&H00dada
                case MENUID_COLOR_GREEN : b_color=&h00aa00
                case MENUID_COLOR_BLUE  : b_color=&haa0000
                case MENUID_COLOR_VIOLET: b_color=&haa00aa
                case MENUID_COLOR_WHITE : b_color=&Hffffff
                '===================================================================
                'CUSTOM COLORS
                case MENUID_COLOR_CUSTOM
                    dim as CHOOSECOLOR cc
                    static as COLORREF customColors (0 to 15) = { &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa, _
                                                                  &h00aaaaaa, &h00aaaaaa }
                    with cc
                        .lStructSize = sizeof(CHOOSECOLOR)
                        .lpCustColors = @customColors(0)
                        .Flags = CC_SOLIDCOLOR
                    end with
                    print ChooseColor( @cc )
                    b_color = (cc.rgbResult)
                '===================================================================
                case MENUID_HELP_ABOUT : MessageBox(hWnd,help_text,"Picto-Font Help",MB_OK)
            end select
        case else : return DefWindowProc( hWnd, message , wParam, lParam )
    end select
    return 0
end function
'===============================================================================
'===============================================================================
'WinMain
'===============================================================================
'===============================================================================
function WinMain ( byval hInstance as HINSTANCE, _
                   byval hPrevInstance as HINSTANCE, _
                   byref szCmdLine as string, _
                   byval iCmdShow as integer ) as integer
    function = 0
    dim appName as string = "Picto-Font"
    dim wMsg as MSG
    dim wcls as WNDCLASS
        with wcls
            .style         = CS_HREDRAW or CS_VREDRAW
            .lpfnWndProc   = @WndProc
            .cbClsExtra    = 0
            .cbWndExtra    = 0
            .hInstance     = hInstance
            .hIcon         = LoadIcon( NULL, IDI_APPLICATION )
            .hCursor       = LoadCursor( NULL, IDC_ARROW )
            .hbrBackground = GetStockObject( LTGRAY_BRUSH )
            .lpszMenuName  = NULL
            .lpszClassName = strptr( appName )
        end with
    if( RegisterClass( @wcls ) = FALSE ) then
        exit function
    end if
    ' Create window
    hWnd = CreateWindowEx( 0, appname, _
                           "Picto-Font Version 9.0 Febuary | 2019", _
                           WS_OVERLAPPEDWINDOW, _
                           200, _
                           10, _
                           800, _
                           725, _
                           NULL, _
                           NULL, _
                           hInstance, _
                           NULL )

    ShowWindow( hWnd, iCmdShow )
    UpDateWindow( hWnd )
    while( GetMessage( @wMsg, NULL, 0, 0 ) <> FALSE )
        TranslateMessage( @wMsg )
        DispatchMessage( @wMsg )
    wend
    function = wMsg.wParam
end function
'===============================================================================
'===============================================================================
sub getfilename()
        dim ofn as OPENFILENAME
        dim filename as zstring * MAX_PATH+1
        with ofn
                .lStructSize            = sizeof( OPENFILENAME )
                .hwndOwner              = hWnd
                .hInstance              = GetModuleHandle( NULL )
               
                if file_type="pft" then .lpstrFilter            = strptr( !"Picto-Font Files , (*.pft)\0*.pft\0\0")
                if file_type="bmp" then .lpstrFilter            = strptr( !"BitMap Files , (*.bmp)\0*.bmp\0\0")
               
                .lpstrCustomFilter      = NULL
                .nMaxCustFilter         = 0
                .nFilterIndex           = 1
                .lpstrFile              = @filename
                .nMaxFile               = sizeof( filename )
                .lpstrFileTitle         = NULL
                .nMaxFileTitle          = 0
                .lpstrInitialDir        = NULL
                .lpstrTitle             = @"Save File"
                .Flags                  = OFN_EXPLORER 'or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
                .nFileOffset            = 0
                .nFileExtension         = 0
                .lpstrDefExt            = NULL
                .lCustData              = 0
                .lpfnHook               = NULL
                .lpTemplateName         = NULL
        end with
        if( GetOpenFileName( @ofn ) = FALSE ) then
            file = ""
            return
        else
            dim ext as string
            ext = right$(filename,4)
            if file_type="pft" then
                if ext <> ".pft" then
                    filename = filename + ".pft"
                end if
            end if
            if file_type="bmp" then
                if ext <> ".bmp" then
                    filename = filename + ".bmp"
                end if
            end if
           
            file = filename
       
        endif
end sub
'===============================================================================
'===============================================================================
'menu stuff below here
'===============================================================================
'===============================================================================
sub menu_insert( byval hmenu as HMENU, byval submenu as integer, byref title as string, byval flags as integer = 0 )
    with submenuTB(submenu)
            .hnd         = CreatePopupMenu( )
            InsertMenu( hmenu, submenu, MF_BYPOSITION Or MF_POPUP Or MF_STRING or flags, cuint( .hnd ), title )
    end with
end sub
'===============================================================================
sub menu_append( byval submenu as integer, byval id as integer, byref title as string, byval flags as integer = 0 )
    AppendMenu( submenuTB(submenu).hnd, MF_STRING or flags, id, title )
end sub
'===============================================================================
sub menu_separator( byval submenu as integer )
    AppendMenu( submenuTB(submenu).hnd, MF_SEPARATOR, 0, NULL )
end sub
'===============================================================================
sub init_menus( byval hWnd as HWND )
    dim menu as HMENU
    menu = CreateMenu( )
    'File
    menu_insert( menu, 0, "&File" )
    menu_append( 0, MENUID_FILE_CLEAR, "&CLEAR-GLYPH" )
    menu_append( 0, MENUID_FILE_OPEN, "&Open")
    menu_separator( 0 )
    menu_append( 0, MENUID_FILE_SAVE, "&Save")
    menu_append( 0, MENUID_FILE_SAVE_AS_BMP , "&Save as BMP")
    menu_separator( 0 )
    menu_append( 0, MENUID_FILE_SAVE_INPUT_AS_BMP , "&Save Input as BMP")
    menu_separator( 0 )
    menu_append( 0, MENUID_FILE_EXIT, "&Exit" )
    'brush_size_01's
    menu_insert(menu, 1, "&Brush Size 1's")
    menu_append( 1,MENUID_BRUSH_SIZE_0_ZERO,  "RESET ONES" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_1   ,  "1%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_2   ,  "2%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_3   ,  "3%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_4   ,  "4%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_5   ,  "5%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_6   ,  "6%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_7   ,  "7%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_8   ,  "8%" )
    menu_append( 1,MENUID_BRUSH_SIZE_0_9   ,  "9%" )
    'brush_size_10's
    menu_insert(menu, 2, "&Brush Size 10's")
    menu_append( 2,MENUID_BRUSH_SIZE_ZERO_0, "RESET TENS" )
    menu_append( 2,MENUID_BRUSH_SIZE_1_0   , "10%" )
    menu_append( 2,MENUID_BRUSH_SIZE_2_0   , "20%" )
    menu_append( 2,MENUID_BRUSH_SIZE_3_0   , "30%" )
    menu_append( 2,MENUID_BRUSH_SIZE_4_0   , "40%" )
    menu_append( 2,MENUID_BRUSH_SIZE_5_0   , "50%" )
    menu_append( 2,MENUID_BRUSH_SIZE_6_0   , "60%" )
    menu_append( 2,MENUID_BRUSH_SIZE_7_0   , "70%" )
    menu_append( 2,MENUID_BRUSH_SIZE_8_0   , "80%" )
    menu_append( 2,MENUID_BRUSH_SIZE_9_0   , "90%" )
    'glyph_x
    menu_insert(menu, 3, "&Glyph X Size")
    menu_append(3,MENUID_GLYPH_X_4 ,"&4")
    menu_append(3,MENUID_GLYPH_X_8 ,"&8")
    menu_append(3,MENUID_GLYPH_X_10,"&10")
    menu_append(3,MENUID_GLYPH_X_12,"&12")
    menu_append(3,MENUID_GLYPH_X_14,"&14")
    menu_append(3,MENUID_GLYPH_X_16,"&16")
    menu_append(3,MENUID_GLYPH_X_18,"&18")
    menu_append(3,MENUID_GLYPH_X_20,"&20")
    menu_append(3,MENUID_GLYPH_X_22,"&22")
    menu_append(3,MENUID_GLYPH_X_24,"&24")
    menu_append(3,MENUID_GLYPH_X_26,"&26")
    menu_append(3,MENUID_GLYPH_X_28,"&28")
    menu_append(3,MENUID_GLYPH_X_30,"&30")
    menu_append(3,MENUID_GLYPH_X_32,"&32")
    menu_append(3,MENUID_GLYPH_X_48,"&48")
    menu_append(3,MENUID_GLYPH_X_64,"&64")
    'glyph_y
    menu_insert(menu, 4, "&Glyph Y Size")
    menu_append(4,MENUID_GLYPH_Y_4 ,"&4")
    menu_append(4,MENUID_GLYPH_Y_8 ,"&8")
    menu_append(4,MENUID_GLYPH_Y_10,"&10")
    menu_append(4,MENUID_GLYPH_Y_12,"&12")
    menu_append(4,MENUID_GLYPH_Y_14,"&14")
    menu_append(4,MENUID_GLYPH_Y_16,"&16")
    menu_append(4,MENUID_GLYPH_Y_18,"&18")
    menu_append(4,MENUID_GLYPH_Y_20,"&20")
    menu_append(4,MENUID_GLYPH_Y_22,"&22")
    menu_append(4,MENUID_GLYPH_Y_24,"&24")
    menu_append(4,MENUID_GLYPH_Y_26,"&26")
    menu_append(4,MENUID_GLYPH_Y_28,"&28")
    menu_append(4,MENUID_GLYPH_Y_30,"&30")
    menu_append(4,MENUID_GLYPH_Y_32,"&32")
    menu_append(4,MENUID_GLYPH_Y_48,"&48")
    menu_append(4,MENUID_GLYPH_Y_64,"&64")
    'brush color
    menu_insert( menu, 5, "&Brush_Color" )
    menu_append(5,MENUID_COLOR_BLACK , "&Black" )
    menu_append(5,MENUID_COLOR_BROWN , "&Brown" )
    menu_append(5,MENUID_COLOR_RED   , "&Red"   )
    menu_append(5,MENUID_COLOR_ORANGE, "&Orange")
    menu_append(5,MENUID_COLOR_YELLOW, "&Yellow")
    menu_append(5,MENUID_COLOR_GREEN , "&Green" )
    menu_append(5,MENUID_COLOR_BLUE  , "&Blue"  )
    menu_append(5,MENUID_COLOR_VIOLET, "&Violet")
    menu_append(5,MENUID_COLOR_WHITE , "&White" )
    menu_separator( 5 )
    menu_append(5,MENUID_COLOR_CUSTOM, "&Custom")
    'ratio
    menu_insert(menu, 6, "&Glyph_Ratio")
    menu_append(6,MENUID_RATIO_4  , "&4"  )
    menu_append(6,MENUID_RATIO_6  , "&6"  )
    menu_append(6,MENUID_RATIO_8  , "&8"  )
    menu_append(6,MENUID_RATIO_10 , "&10" )
    'help
    menu_insert( menu, 7, "&HELP" )
    menu_append( 7 ,MENUID_HELP_ABOUT , "&About" )
    '===============================================================================
    SetMenu( hWnd, menu )
    DrawMenuBar( hWnd )
end sub

UEZ
Posts: 312
Joined: May 05, 2017 19:59
Location: Germany

Re: Picto-Font_V9

Postby UEZ » Feb 08, 2019 23:33

albert wrote:It still can't load BMP's , but can save the input or output as a bmp..


You can use GDIPlus to load / save images in different formats. You can convert the GDIPlus image back to GDI easily.
Further the screen flickers when drawing -> use buffered technique to display flicker free.

First create handles:

Code: Select all

Dim As Any Ptr hDC = GetDC(hHWND), _
               hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
               hDC_backbuffer = CreateCompatibleDC(hDC), hPen
Var hObjOld = SelectObject(hDC_backbuffer, hHBitmap)


Then draw directly to hDC_backbuffer and the last step is to copy the bitmap to dc using BitBlt(hDC, 0, 0, iW, iH, hDC_backbuffer, 0, 0, SRCCOPY).

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 2 guests