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