I wont be continuing my font editor program (much like the profiles DLL). So, here's the code. The DLL code can be found on my web site.
Rem Project: FontEditor
Rem Created: 25/09/2003 12:27:52
Rem ***** Main Source File *****
#constant MAX_BITMAPS 255
#constant FALSE 0
#constant TRUE 1
#constant BITMAP_VIEW 1
#constant BITMAP_STORE 2
#constant BITMAP_LARGE 256
#constant IMAGE_VIEW 1
#constant SPRITE_VIEW 1
#constant _WIDTH 1024
#constant _HEIGHT 768
#constant _BPP 32
#constant MAX_WIDTH 64
#constant MAX_HEIGHT 64
#constant _DLL 1
#constant CANCEL -1
#constant NONE 0
#constant HORZ 1<<0
#constant VERT 1<<1
#constant DIAG 1<<2
#constant PROGRAMVERSION "Version : 0.0.0.1"
if check display mode (_WIDTH,_HEIGHT,_BPP)=0
print "You must be able to run 1024x768x32"
wait key
end
endif
set display mode _WIDTH,_HEIGHT,_BPP
sync on
sync rate 0
cls 0:sync
randomize timer()
dim map(MAX_WIDTH,MAX_HEIGHT)
gridWidth as integer
gridHeight as integer
mX as integer
pMX as integer
mY as integer
pMY as integer
mC as integer
kP as integer
currentBitmap as integer
mirror as integer
plottingColour as DWORD
global ptr as DWORD
gridWidth=64
gridHeight=64
currentBitmap=1
mirror=NONE
plottingColour=RGB(255,0,0)
cls 0
load dll "FONTEDITOR.DLL",_DLL
ptr=calloc(1024)
createAllBitmaps(gridWidth,gridHeight)
createViewBitmap(gridWidth,gridHeight)
displayGrid(gridWidth,gridHeight)
displayOptions(gridWidth)
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
REM *********************
REM * MAIN PROGRAM LOOP *
REM *********************
pMX=mouseX()
pMY=mouseY()
mX=pMX
mY=pMY
do
repeat
mC=mouseClick()
kP=scancode()
if mX<>pMX or mY<>pMY
highlightBox(pMX,pMY,FALSE,gridWidth,gridHeight)
endif
highlightBox(mX,mY,TRUE,gridWidth,gridHeight)
pMX=mX
pMY=mY
if kP<>0
select kP
case 34 : REM Goto a line
newGoto=call dll (_DLL,"?goToBitmap@@YAHXZ",currentBitmap)
if newGoto<>CANCEL
currentBitmap=newGoto
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
endif
endcase
case 31 : REM Select grid size
newGridSize=call dll (_DLL,"?getGridSize@@YAHH@Z",gridWidth)
if newGridSize<>CANCEL
cls 0
sync
gridWidth=newGridSize
gridHeight=newGridSize
createAllBitmaps(gridWidth,gridHeight)
createViewBitmap(gridWidth,gridHeight)
displayGrid(gridWidth,gridHeight)
displayOptions(gridWidth)
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
endif
endcase
case 80 : REM Scroll down
scrollDown(gridWidth,gridHeight,plottingColour)
endcase
case 72 : REM Scroll up
scrollUp(gridWidth,gridHeight,plottingColour)
endcase
case 77 : REM Scroll right
scrollRight(gridWidth,gridHeight,plottingColour)
endcase
case 75 : REM Scroll left
scrollLeft(gridWidth,gridHeight,plottingColour)
endcase
case 13 : REM Next Bitmap
inc currentBitmap
if currentBitmap>MAX_BITMAPS
currentBitmap=MAX_BITMAPS
endif
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
endcase
case 12 : REM Previous bitmap
dec currentBitmap
if currentBitmap<1
currentBitmap=1
endif
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
endcase
case 59 : REM Mirroring options
result=call dll(_DLL,"?mirroring@@YAHH@Z",mirror)
if result<>CANCEL
mirror=result
endif
endcase
case 60 : REM Set plotting colour
plottingColour=_getColour(plottingColour)
x=msgbox(hex$(plottingColour),"*",1)
endcase
case 63 : REM Save current bitmap as binary
saveBinary(currentBitmap,currentBitmap,gridWidth,gridHeight)
endcase
case 64 : REM Save all bitmaps as binary
saveBinary(1,MAX_BITMAPS,gridWidth,gridHeight)
endcase
case 65 : REM Save current bitmap to file
saveBitmap(currentBitmap,currentBitmap,gridWidth,gridHeight)
endcase
case 66 : REM Save all bitmaps to file
if shiftkey()=0
saveBitmap(1,MAX_BITMAPS,gridWidth,gridHeight)
endif
endcase
case 67 : REM F9 - Save into 1 big bitmap
saveAsOneBitmap(gridWidth,gridHeight)
endcase
case 68 : REM F10 - Copy to current bitmap
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
set current bitmap BITMAP_VIEW
get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0
set current bitmap 0
set current bitmap (currentBitmap-1)+BITMAP_STORE
paste image IMAGE_VIEW,0,0,0
set current bitmap 0
displayCurrentBitmap(currentBitmap,gridWidth,gridHeight)
endcase
case 87 : REM F11 - Clear the grid
displayGrid(gridWidth,gridHeight)
createViewBitmap(gridWidth,gridHeight)
displayViewBitmap(gridWidth,gridHeight)
sync
endcase
case 88 : REM F12 - Exit program
if MsgBox("Are you sure you want to exit this program ?",_
"* Exit Program *",_
MB_YESNO)=IDYES
delete memory ptr
end
endif
endcase
endselect
`ink rgb(255,255,0),0:print kP
endif
mX=mouseX()
mY=mouseY()
until mC<>0
select mC
case 1 : REM Left button pressed
plotPixel(mX,mY,TRUE,gridWidth,gridHeight,mirror,plottingColour)
displayViewBitmap(gridWidth,gridHeight)
endcase
case 2 : REM Right button pressed
plotPixel(mX,mY,FALSE,gridWidth,gridHeight,mirror,plottingColour)
displayViewBitmap(gridWidth,gridHeight)
endcase
endselect
loop
REM Hightlight box which mouse is over
function highlightBox(mX as integer,mY as integer,highlight as integer,_
gridWidth as integer,gridHeight as integer)
local aX as integer
local aY as integer
aX=mX/8
aY=mY/8
if aX>=0 and aX<=gridWidth-1 and _
aY>=0 and aY<=gridHeight-1
if highlight=TRUE
ink rgb(rnd(256),rnd(256),rnd(256)),0
else
ink 0,0
endif
line (aX*8)-1,(aY*8)-1,(aX*8)+8,(aY*8)-1
line (aX*8)+7,(aY*8)-1,(aX*8)+7,(aY*8)+8
line (aX*8)-1,(aY*8)+7,(aX*8)+8,(aY*8)+7
line (aX*8)-1,(aY*8)-1,(aX*8)-1,(aY*8)+7
endif
sync
endfunction
function _getColour(plottingColour as DWORD)
local result as DWORD
local r as integer
local g as integer
local b as integer
r=(plottingColour>>16) && 255
g=(plottingColour>>8) && 255
b=plottingColour && 255
result=(b<<16)+(g<<8)+r
if GetColour(ptr,CC_RGBINIT || CC_FULLOPEN,0,result)>0
r=peekB(ptr,0)
g=peekB(ptr,1)
b=peekB(ptr,2)
result=(r<<16)+(g<<8)+b
else
result=plottingColour
endif
endfunction result
REM Put a pixel in the main display and update the actual size bitmap
function __plotPixel(aX as integer,aY as integer,plot as integer,_
gridWidth as integer,gridHeight as integer,_
plottingColour as DWORD)
if aX>=0 and aX<=gridWidth-1 and _
aY>=0 and aY<=gridHeight-1
if plot=TRUE
ink plottingColour,0
else
ink rgb(255,255,255),0
endif
box aX*8,aY*8,(aX*8)+7,(aY*8)+7
set current bitmap BITMAP_VIEW
if plot=TRUE
dot aX,aY,plottingColour
map(aX,aY)=plottingColour
else
dot aX,aY,0
map(aX,aY)=0
endif
set current bitmap 0
endif
sync
endfunction
function plotPixel(mX as integer,mY as integer,plot as integer,_
gridWidth as integer,gridHeight as integer,_
mirror as integer,_
plottingColour as DWORD)
local aX as integer
local aY as integer
aX=mX/8
aY=mY/8
__plotPixel(aX,aY,plot,gridWidth,gridHeight,plottingColour)
REM Now check for horizontal mirroring
if mirror && HORZ
__plotPixel(gridWidth-aX-1,aY,plot,gridWidth,gridHeight,plottingColour)
endif
if mirror && VERT
__plotPixel(aX,gridHeight-aY-1,plot,gridWidth,gridHeight,plottingColour)
endif
if mirror && DIAG
__plotPixel(gridWidth-aX-1,gridHeight-aY-1,plot,gridWidth,gridHeight,plottingColour)
endif
endfunction
REM Display an empty grid
function displayGrid(gridWidth as integer,gridHeight as integer)
local x as integer
local y as integer
ink rgb(255,255,255),0
for x=0 to gridWidth-1
for y=0 to gridHeight-1
box x*8,y*8,(x*8)+7,(y*8)+7
map(x,y)=0
next y
next x
sync
endfunction
function createViewBitmap(gridWidth as integer,gridHeight as integer)
if bitmap exist(BITMAP_VIEW)<>0
delete bitmap BITMAP_VIEW
endif
create bitmap BITMAP_VIEW,gridWidth,gridHeight
set current bitmap BITMAP_VIEW
cls 0
set current bitmap 0
endfunction
function displayViewBitmap(gridWidth as integer,gridHeight as integer)
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
set current bitmap BITMAP_VIEW
get image IMAGE_VIEW,0,0,gridWidth,gridHeight,1
set current bitmap 0
paste image IMAGE_VIEW,screen width()-gridWidth-1,screen height()-gridHeight-1,0
sync
endfunction
function displayOptions(gridWidth as integer)
local sW as integer
local text$ as string
local yP as integer
yP=0
restore
read text$
while text$<>"*"
text 520,yP,text$
inc yP,text height(text$)
read text$
endwhile
text 900,0,PROGRAMVERSION
sync
endfunction
function displayCurrentBitmap(currentBitmap as integer,gridWidth as integer,gridHeight as integer)
local text$ as string
local x as integer
local y as integer
text$="Current Bitmap Selected : "+str$(currentBitmap)
ink rgb(0,255,0),0
x=0
y=(gridHeight*8)+8
box x,y,x+text width(text$)+32,y+text height(text$),0,0,0,0
text x,y,text$
rem Display the current selected bitmap
if bitmap exist (currentBitmap)<>0
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
x=0
y=screen height()-gridHeight-2
set current bitmap (currentBitmap-1)+BITMAP_STORE
get image IMAGE_VIEW,0,0,gridWidth,gridHeight,1
set current bitmap 0
ink rgb(0,0,255),0
line x,y,x+gridWidth+1,y
line x+gridWidth+1,y,x+gridWidth+1,y+gridHeight+1
line x,y+gridHeight+1,x+gridWidth+1,y+gridHeight+1
line x,y,x,y+gridHeight+1
paste image IMAGE_VIEW,x+1,y+1,0
endif
sync
endfunction
function deleteAllBitmaps()
local l as integer
local bM as integer
for l=1 to MAX_BITMAPS
bM=BITMAP_STORE+(l-1)
if bitmap exist(bM)<>0
delete bitmap bM
endif
next l
endfunction
function createAllBitmaps(gridWidth as integer,gridHeight as integer)
local l as integer
local bM as integer
deleteAllBitmaps()
for l=1 to MAX_BITMAPS
bM=BITMAP_STORE+(l-1)
create bitmap bM,gridWidth,gridHeight
next l
endfunction
function saveBinary(startBitmap as integer,endBitmap as integer,_
gridWidth as integer,gridHeight as integer)
local l as integer
local x as integer
local y as integer
local fileName$ as string
local c as DWORD
fileName$="C:\OUTPUT.DAT"
if file exist(fileName$)<>0
delete file fileName$
endif
open to write 1,fileName$
write byte 1,gridWidth
write byte 1,gridHeight
for l=startBitmap to endBitmap
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
set current bitmap (l-1)+BITMAP_STORE
get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0
write byte 1,gridWidth
write byte 1,gridHeight
write byte 1,l
for y=0 to gridHeight-1
for x=0 to gridWidth-1
write long 1,point(x,y)
next x
next y
set current bitmap 0
next l
endfunction
function saveBitmap(startBitmap as integer,endBitmap as integer,_
gridWidth as integer,gridHeight as integer)
local l as integer
local fileName$ as string
fileName$="C:\OUTPUT"
for l=startBitmap to endBitmap
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
set current bitmap (l-1)+BITMAP_STORE
get image IMAGE_VIEW,0,0,gridWidth,gridHeight,0
set current bitmap 0
if startBitmap=endBitmap
save image fileName$+".BMP",IMAGE_VIEW
else
save image fileName$+str$(l)+".BMP",IMAGE_VIEW
endif
next l
endfunction
function saveAsOneBitmap(gridWidth as integer,gridHeight as integer)
local x as integer
local y as integer
local fileName$ as string
local xP as integer
local yP as integer
fileName$="C:\OUTPUT.BMP"
if file exist(fileName$)<>0
delete file fileName$
endif
if bitmap exist(BITMAP_LARGE)<>0
delete bitmap BITMAP_LARGE
endif
create bitmap BITMAP_LARGE,(16*gridWidth)+gridWidth,(16*gridHeight)+gridHeight
l=1
for y=1 to 16
for x=1 to 16
xP=(x-1)*gridWidth
yP=(y-1)*gridHeight
if l<=MAX_BITMAPS
copy bitmap (l-1)+BITMAP_STORE,0,0,gridWidth,gridHeight,BITMAP_LARGE,xP,yP,xP+gridWidth,yP+gridHeight
endif
inc l
next x
next y
set current bitmap BITMAP_LARGE
if image exist(IMAGE_VIEW)<>0
delete image IMAGE_VIEW
endif
get image IMAGE_VIEW,0,0,16*gridWidth,16*gridHeight
set current bitmap 0
save image fileName$,IMAGE_VIEW
endfunction
function updateGridAndView(gridWidth as integer,gridHeight as integer,_
plottingColour as DWORD)
local x as integer
local y as integer
set current BITMAP BITMAP_VIEW
cls 0
set current bitmap 0
for y=0 to gridHeight-1
for x=0 to gridWidth-1
if map(x,y)<>0
__plotPixel(x,y,TRUE,gridWidth,gridHeight,plottingColour)
else
__plotPixel(x,y,FALSE,gridWidth,gridHeight,plottingColour)
endif
next x
next y
endfunction
function scrollLeft(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer
for y=0 to gridHeight-1
for x=1 to gridWidth-1
map(x-1,y)=map(x,y)
next x
map(gridWidth-1,y)=0
next y
updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction
function scrollRight(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer
for y=0 to gridHeight-1
for x=gridWidth-2 to 0 step -1
map(x+1,y)=map(x,y)
next x
map(0,y)=0
next y
updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction
function scrollUp(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer
for y=1 to gridHeight-1
for x=0 to gridWidth-1
map(x,y-1)=map(x,y)
next x
next y
for x=0 to gridWidth-1
map(x,gridHeight-1)=0
next x
updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction
function scrollDown(gridWidth as integer,gridHeight as integer,plottingColour as DWORD)
local x as integer
local y as integer
for y=gridHeight-2 to 0 step -1
for x=0 to gridWidth-1
map(x,y+1)=map(x,y)
next x
next y
for x=0 to gridWidth-1
map(x,0)=0
next x
updateGridAndView(gridWidth,gridHeight,plottingColour)
endfunction
REM ****************
REM * OPTIONS DATA *
REM ****************
DATA "+ - Next Bitmap"
DATA "- - Previous Bitmap"
DATA "------------------------------------------------"
DATA "G - Goto Bitmap Number"
DATA "S - Set Grid Size"
DATA "8 - Scroll One Line Up"
DATA "2 - Scroll One Line Down"
DATA "4 - Scroll One Line Left"
DATA "6 - Scroll One Line Right"
DATA "------------------------------------------------"
DATA "F1 - Mirroring Options"
DATA "F2 - Select Plotting Colour"
DATA "F3 - Load Binary Data"
DATA "F4 - Merge Binary Data into Current Bitmap"
DATA "F5 - Save Current Bitmap as Binary Data"
DATA "F6 - Save All Bitmaps as Binary Data"
DATA "F7 - Save Current Bitmap to File"
DATA "F8 - Save All Bitmaps To File"
DATA "F9 - Save All Bitmaps into One Bitmap"
DATA "F10 - Copy graphic To Current Bitmap"
DATA "F11 - Clear Grid"
DATA "F12 - Exit Program"
DATA "*"
Avatar & Logo by Indi. Insert witty comment here...
