In the past no one has really shown any interest in this kind of thing and I didn't want to clog up the forum with my waffling on about it. However if you are still interested the code below (which I have posted somewhere before) might be somewhere to start.
How it works is image1 is scanned top to bottom, left to right. When a non black pixel is found it takes it as a pixel in a blob. It then fills the blob with black pixels (so they will not be looked at again during the scan for more blobs) while it computes some blob descriptors. An issue with the current example is with the inner blobs you find in a P or B and so on are not recorded because the background color is black.
Blobs can contain blobs that can contain more blobs so that is part of describing a blob. Maybe not so important for printed characters however a face has a blob for the head, blobs for eyes, maybe two nostril blobs and a maybe a mouth blob.
There are issues with text with regards reading left to right, top to bottom, and recognizing the space between words. Some characters like % have three blobs spatially related to each other.
For some reason I can't get the code used to create the image below to work in the program below to fill in the inner blobs by having a color background and using paint to fill the outside with black pixels.
The code example below doesn't do any recognizing of blobs which would require using an extracted blob description to compare with a list of descriptions for each blob type to be recognized.
The example also skips the issue of converting an actual image of a page of text taken by a camera into a binary form. If a page of text is scanned then usually a simple threshold function will be sufficient. If it is a photo of a page then shading can actually mean you need a variable threshold function like the one I used in the target example. However using these ideal binary images allows the exploration of ways to convert a blob into a description that can be used for character recognition.
Code: Select all
screenres 1280,600,32
'====================================
'Fonts by MYSOFT.
'====================================
'http://www.freebasic.net/forum/viewtopic.php?f=2&t=23343&hilit=windows+api+font
'
#include "windows.bi"
#include "fbgfx.bi"
enum
FS_BOLD = 2
FS_ITALIC = 4
FS_ANTIALIAS = 8
FS_BLUR = 16+8
End enum
Sub DrawFont(byref BUFFER As Any Ptr=0,byval POSX As Integer, byval POSY As Integer, _
byref FTEXT As String, byref FNAME As String,byval FSIZE As Integer, _
byval FCOLOR As Uinteger=rgba(255,255,255,0),byval FSTYLE As Integer=0,byval CHARSET As Integer=DEFAULT_CHARSET )
Static FINIT As Integer
Static As hdc THEDC
Static As hbitmap THEBMP
Static As Any Ptr THEPTR
Static As fb.image Ptr FBBLK
Static As Integer WIDCHAR(65535)
Static As Integer TXTSZ,COUNT,RESU,RESUU
Static As Any Ptr SRCBUF,DSTBUF
Static As hfont THEFONT
Static As Integer FW,FI,TXYY,FCOR
Static DSKWND As hwnd, DSKDC As hdc
Static MYBMPINFO As BITMAPINFO
Static As TEXTMETRIC MYTXINFO
Static As SIZE TXTSIZE
Static As RECT RCT
#define GAMMA 1.3
#define FontSize(PointSize) -MulDiv(PointSize, GetDeviceCaps(THEDC, LOGPIXELSY), 72)
If FINIT = 0 Then
FINIT = 1
With MYBMPINFO.bmiheader
.biSize = sizeof(BITMAPINFOHEADER)
.biWidth = 2048
.biHeight = -513
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
End With
DSKWND = GetDesktopWindow()
DSKDC = GetDC(DSKWND)
THEDC = CreateCompatibleDC(DSKDC)
THEBMP = CreateDIBSection(THEDC,@MYBMPINFO,DIB_RGB_COLORS,@THEPTR,null,null)
ReleaseDC(DSKWND,DSKDC)
End If
If (FSTYLE And FS_BOLD) Then FW = FW_BOLD Else FW = FW_NORMAL
If (FSTYLE And FS_ITALIC) Then FI = True Else FI = False
THEFONT = CreateFont(FontSize(FSIZE),0,0,0,FW,FI,0,0,CHARSET,0,0,0,0,cast(Any Ptr,Strptr(FNAME)))
SelectObject(THEDC,THEBMP)
SelectObject(THEDC,THEFONT)
GetTextMetrics(THEDC,@MYTXINFO)
GetTextExtentPoint32(THEDC,Strptr(FTEXT),Len(FTEXT),@TXTSIZE)
TXTSZ = TXTSIZE.CX
TXYY = TXTSIZE.CY
If (FSTYLE And FS_ITALIC) Then
If MYTXINFO.tmOverhang Then
TXTSZ += MYTXINFO.tmOverhang
Else
TXTSZ += 1+(FSIZE/2)
End If
TXYY += 1+(FSIZE/8)
End If
If (FSTYLE And FS_ANTIALIAS) Then
#if GAMMA>1 And GAMMA <= 2
TXTSZ += GAMMA*2
#endif
End If
With RCT
.LEFT = 0
.TOP = 1
.RIGHT = TXTSZ
.BOTTOM = TXYY+1
End With
TXTSZ -= 1
TXYY -= 1
asm
mov eax,[FCOLOR]
And eax,0xFFFFFF
mov [FCOR],eax
bswap eax
ror eax,8
mov [FCOLOR],eax
End asm
SetBkColor(THEDC,rgba(255,0,255,0))
SetTextColor(THEDC,FCOLOR)
SystemParametersInfo(SPI_GETFONTSMOOTHING,null,@RESU,null)
If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,False,@RESUU,null)
ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)
If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,True,@RESUU,null)
FBBLK = THEPTR+(2048*4)-sizeof(fb.image)
FBBLK->type = 7
FBBLK->bpp = 4
FBBLK->width = 2048
FBBLK->height = 512
FBBLK->pitch = 2048*4
If (FSTYLE And FS_ANTIALIAS) Then
Dim As Any Ptr MYBLK
MYBLK = THEPTR+(2048*4)
asm
mov ecx,2048*511
mov ebx,[FCOR]
mov esi,[MYBLK]
HERE:
cmp [esi], dword Ptr 0xFF00FF
je _TRANS_
mov [esi+3], Byte Ptr 0xFF
_TRANS_:
And [esi], dword Ptr 0xFF000000
Or [esi], ebx
add esi,4
dec ecx
jnz HERE
End asm
Dim As Integer TX,TY
Dim As Integer ALP
#define GetAlpha(PX,PY) Peek(MYBLK+((PY)*8192)+((PX)*4)+3)
#define SetAlpha(PX,PY,NA) Poke(MYBLK+((PY)*8192)+((PX)*4)+3),NA
If (FSTYLE And FS_BLUR) = FS_BLUR Then
For TX = 1 To TXTSZ-1
ALP = (GetAlpha(TX,0)+GetAlpha(TX+1,0)+GetAlpha(TX-1,0)+ _
GetAlpha(TX,1)+GetAlpha(TX-1,1)+GetAlpha(TX+1,1)) / 6
#if GAMMA>1 And GAMMA <= 1.6
ALP *= (GAMMA+.5)
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TX
For TX = 1 To TXTSZ-1
For TY = 1 To TXYY-1
ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+ _
GetAlpha(TX,TY-1)+GetAlpha(TX,TY+1) + _
GetAlpha(TX-1,TY-1)+GetAlpha(TX-1,TY+1)+ _
GetAlpha(TX+1,TY-1)+GetAlpha(TX+1,TY+1)) / 9
#if GAMMA>1 And GAMMA <= 1.6
ALP *= (GAMMA+.5)
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TY
Next TX
For TX = 1 To TXTSZ-1
ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+ _
GetAlpha(TX,TY-1)+GetAlpha(TX-1,TY-1)+GetAlpha(TX+1,TY-1)) / 6
#if GAMMA>1 And GAMMA <= 1.6
ALP *= (GAMMA+.5)
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TX
Else
For TX = 1 To TXTSZ-1
ALP = (GetAlpha(TX,0)+GetAlpha(TX+1,0)+_
GetAlpha(TX-1,0)+GetAlpha(TX,1))/4
#if GAMMA>1 And GAMMA <= 2
ALP *= GAMMA
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TX
For TX = 1 To TXTSZ-1
For TY = 1 To TXYY-1
ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+GetAlpha(TX-1,TY)+_
GetAlpha(TX,TY-1)+GetAlpha(TX,TY+1))/5
#if GAMMA>1 And GAMMA <= 2
ALP *= GAMMA
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TY
Next TX
For TX = 1 To TXTSZ-1
ALP = (GetAlpha(TX,TY)+GetAlpha(TX+1,TY)+ _
GetAlpha(TX-1,TY)+GetAlpha(TX,TY-1))/4
#if GAMMA>1 And GAMMA <= 2
ALP *= GAMMA
If ALP > 255 Then ALP = 255
#endif
SetAlpha(TX,TY,ALP)
Next TX
End If
Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),alpha
Else
Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),trans
End If
DeleteObject(THEFONT)
End Sub
type BlobType
Area as integer
Perimeter as integer
xMin as integer
xMax as integer
yMin as integer
yMax as integer
xTot as integer
yTot as integer
xCentroid as integer
yCentroid as integer
xStart as integer
yStart as integer
end type
dim shared as BlobType Blob
const iCOL = 1280
const iROW = 64
dim shared as any ptr image1,image2,image3
image1 = imagecreate(iCOL,iROW,rgb(0,0,0))
image2 = imagecreate(iCOL,iROW,rgb(0,0,0))
image3 = imagecreate(iCOL,iROW,rgb(0,0,0))
dim shared as integer xp(1000) 'save contour coordinates
dim shared as integer yp(1000)
sub initializeBlob()
Blob.Area = 0
Blob.Perimeter = 0
Blob.xMin = 10000
Blob.xMax = 0
Blob.yMin = 10000
Blob.yMax = 0
Blob.xTot = 0
Blob.yTot = 0
Blob.xCentroid = 0
Blob.yCentroid = 0
Blob.xStart = 0
Blob.yStart = 0
end sub
dim shared as integer AREA1
dim shared as integer length 'length of outline
dim shared as integer xMin,xMax,yMin,yMax 'box traversed blob
Sub getBlob (x As Integer, y As Integer,image1 as any ptr, colour As uInteger,image2 as any ptr)
'clear image2 used as blobs destination
line image2,(0,0)-(iCOL,iROW),rgb(0,0,0),bf
'create a stack
Dim as integer xs(1000),ys(1000),stkptr
' initialize blob data
Blob.xStart = x
Blob.yStart = y
Blob.perimeter = 0
Blob.Area = 0
Blob.xMin = iCOL
Blob.xMax = 0
Blob.yMin = iROW
Blob.yMax = 0
Blob.xTot = 0
Blob.yTot = 0
' -----------------
'stack first item
xs(stkptr) = x
ys(stkptr) = y
stkptr = stkptr + 1
do
'unstack item
stkptr = stkptr - 1
x = xs(stkptr)
y = ys(stkptr)
'move left if required
if x>0 then
while point(x-1,y,image1)=colour
x = x - 1
wend
end if
if point(x,y+1,image1)=colour and point(x-1,y+1,image1)=colour then
xs(stkptr)=x
ys(stkptr)=y+1
stkptr = stkptr + 1
end if
if point(x,y-1,image1)=colour and point(x-1,y-1,image1)=colour then
xs(stkptr)=x
ys(stkptr)=y-1
stkptr = stkptr + 1
end if
if point(x-1,y+1,image1)=colour and point(x,y+1,image1)<>colour then
xs(stkptr)=x-1
ys(stkptr)=y+1
stkptr = stkptr + 1
end if
if point(x-1,y-1,image1)=colour and point(x,y-1,image1)<>colour then
xs(stkptr)=x-1
ys(stkptr)=y-1
stkptr = stkptr + 1
end if
'move right setting pixels
while point(x,y,image1)=colour
if point(x,y+1,image1)=colour and point(x-1,y+1,image1)<> colour then
'stack new horizontal line
xs(stkptr) = x
ys(stkptr) = y+1
stkptr = stkptr + 1
end if
if point(x,y-1,image1)=colour and point(x-1,y-1,image1)<> colour then
'stack new horizontal line
xs(stkptr) = x
ys(stkptr) = y-1
stkptr = stkptr + 1
end if
if point(x+1,y-1,image1)=colour and point(x,y-1,image1)<> colour then
'stack new horizontal line
xs(stkptr) = x+1
ys(stkptr) = y-1
stkptr = stkptr + 1
end if
if point(x+1,y+1,image1)=colour and point(x,y+1,image1)<> colour then
'stack new horizontal line
xs(stkptr) = x+1
ys(stkptr) = y+1
stkptr = stkptr + 1
end if
pset image1,(x,y),rgb(0,0,0) 'erase pixel to show it has been processed
pset image2,(x,y),colour 'save blob in image2()
'------- update blob data ---------
Blob.Area = Blob.Area + 1
Blob.xTot = Blob.xTot + x
Blob.yTot = Blob.yTot + y
if x > Blob.xMax then Blob.xMax = x
if y > Blob.yMax then Blob.yMax = y
if x < Blob.xMin then Blob.xMin = x
if y < Blob.yMin then Blob.yMin = y
'----------------------------------
x = x + 1
wend
'check stack for more items
loop until stkptr = 0
end sub
sub TraverseBlob(x as integer, y as integer,image2 as any ptr,c as uinteger)
dim as integer ox,oy,sx,sy,direction,cc
AREA1 = 0
direction = 0
ox = x
oy = y
sx = x
sy = y
cc = point(x,y,image2) 'color to draw outline
xMin = 320
yMin = 320
xMax = 0
yMax = 0
do
xp(Blob.perimeter)= x - sx
yp(Blob.perimeter)= y - sy
if x>xMax then xMax = x
if x<xMin then xMin = x
if y>yMax then yMax = y
if y<yMin then yMin = y
select case as const direction
'EAST
case 0
if point(x+1,y-1,image2) = c then
direction = 3 'north
else
if point(x+1,y,image2) <> c then
direction = 1 'south
end if
end if
x = x + 1
'SOUTH
case 1
if point(x,y+1,image2) = c then
direction = 0 'east
else
if point(x-1,y+1,image2) <> c then
direction = 2 'west
end if
end if
y = y + 1
'WEST
case 2
if point(x-2,y,image2) = c then
direction = 1 'south
else
if point(x-2,y-1,image2) <> c then
direction = 3 'north
end if
end if
x = x - 1
'NORTH
case 3
if point(x-1,y-2,image2) = c then
direction = 2 'west
else
if point(x,y-2,image2) <> c then
direction = 0 'east
end if
end if
y = y - 1
end select
pset image3,(x,y),rgb(255,0,0) 'display outline top/right quadrant
'put (0,120),image3,pset
'-- computes area of blob while traversing --'
AREA1 = AREA1 + (x * (y-oy))-(y * (x-ox))
'--------------------------------------------'
length = length + 1
ox = x
oy = y
'sleep 1
Blob.perimeter = Blob.perimeter + 1
loop until sx = x and sy = y
AREA1 = AREA1\2 'final adjustment
end sub
sub PrintBlobData()
screenlock
cls
'display the bitmaps
put (0,0),image1,pset
put (0,80),image2,pset
put (0,160),image3,pset
locate 32,1
print " *** JUST SOME OF THE SHAPE DATA ***"
print
print "Blob Area2 =";Blob.Area
print "Blob Area1 =";AREA1
print "perimeter =";Blob.perimeter
print "rect width =";Blob.xMax - Blob.xMin
print "rect height =";Blob.yMax - Blob.yMin
print "Blob.xCentroid";Blob.xTot\Blob.Area
print "Blob.yCentroid";Blob.yTot\Blob.Area
screenunlock
sleep
end sub
cls
dim as string text
read text
drawfont (image1,1,1,text,"Comic Sans MS",30,rgb(55,55,255),FS_BOLD)
line (0,0)-(iCOL-1,iROW-1),rgb(0,0,0),b 'black border
'=============================================================================
'scans image array finding, extracting and traversing blobs
for j as integer = 1 to iROW-1
for i as integer = 1 to iCOL-1
if point(i,j,image1) <> rgb(0,0,0) then
'extract blob from image1() and copy into image2()
getBlob(i,j,image1,point(i,j,image1),image2)
'traverse the blob to get its contour data
traverseBlob(i,j,image2,point(i,j,image2))
'print some data extracted from blob
printBlobData()
'sleep
end if
next i
next j
sleep
data "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"