Hi Serge
With the permission of mr. Edward (edk)
here my contribution
Code: Select all
* modyfied by edk
*+--------------------------------------------------------------------
*+
*+ Source Module => c:\hmg.3.4.4\0\INK\\HBINK.PRG
*+
*+ Copyright(C) 1983-2021 by Auge & Ohr
*+
*+ Functions: Procedure MAIN()
*+ Procedure DoInitInk()
*+ Procedure RecognizeInk()
*+ Procedure SaveInk()
*+
*+ Reformatted by Click! 2.05.39 on Mar-25-2022 at 1:09 am
*+
*+--------------------------------------------------------------------
#include "HMG.CH"
#include "fileio.ch"
#include "inksdk.ch"
STATIC numeroQ := 0
STATIC cFileName
STATIC DirNc , aStruct
STATIC miras := ".Gif"
STATIC myRecognizers
STATIC myInkCollector
MEMVAR _HMG_SYSDATA
*+--------------------------------------------------------------------
*+
*+ Procedure MAIN()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE MAIN
SET TOOLTIPSTYLE BALLOON
DirNc := HB_Curdrive() +":\"+Rtrim(Curdir() ) + "\"
IF !HB_DirExists(".\Organize" )
DirMake( ".\Organize" )
ENDIF
DIRCHANGE( DirNc )
IF ! FILE("CapNum.dbf")
Contador_1()
ENDIF
DEFINE WINDOW InkMain ;
AT 0, 0 ;
WIDTH 537 ;
HEIGHT 430 ;
TITLE "" ;
ICON NIL ;
ON INIT DoInitInk() ;
ON RELEASE Nil ;
ON INTERACTIVECLOSE Nil ;
NOSIZE ;
NOMAXIMIZE ;
NOMINIMIZE ;
ON PAINT Nil ;
BACKCOLOR { 192, 192, 192 }
ON KEY ESCAPE ACTION ThisWindow.Release
#define Use_Label
#ifdef Use_Label
DEFINE LABEL Label_1
ROW 10
COL 15
WIDTH 500
HEIGHT 120
VALUE ""
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "write or draw something"
VISIBLE .T.
TRANSPARENT .F.
ACTION Nil
AUTOSIZE .F.
BACKCOLOR Nil
FONTCOLOR Nil
END LABEL
#else
DEFINE IMAGE Image_1
ROW 10
COL 15
WIDTH 500
HEIGHT 120
PICTURE nil
VISIBLE .T.
// STRETCH .T.
ACTION nil
TRANSPARENT .T.
BACKGROUNDCOLOR WHITE
TOOLTIP "write or draw something"
END IMAGE
#endif
DEFINE RADIOGROUP Radio_1
ROW 136
COL 150
OPTIONS { 'Gif','Jpg','Png','Bmp' }
BACKCOLOR { 192, 192, 192 }
VALUE 1
WIDTH 110
FONTNAME "Arial"
FONTSIZE 10
TOOLTIP ''
HORIZONTAL .T.
SPACING 055
ONCHANGE Busca_Format()
END RADIOGROUP
DEFINE BUTTON Button_Ink
ROW 167
COL 15
WIDTH 232
HEIGHT 40
ACTION RecognizeInk()
CAPTION "&Regcognize"
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Regcognize what have input"
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
DEFINE BUTTON Button_Save
ROW 167
COL 283
WIDTH 232
HEIGHT 40
ACTION SaveInk()
CAPTION "&Save"
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Save Input to GIF"
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
DEFINE EDITBOX Edit_1
ROW 216
COL 15
WIDTH 500
HEIGHT 120
VALUE ""
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Result Regcognize"
ONCHANGE Nil
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
TABSTOP .T.
VISIBLE .T.
READONLY .F.
HSCROLLBAR .T.
VSCROLLBAR .T.
DISABLEDBACKCOLOR Nil
DISABLEDFONTCOLOR Nil
BACKCOLOR Nil
FONTCOLOR Nil
END EDITBOX
DEFINE BUTTON Button_Clea1
ROW 346
COL 015
WIDTH 111
HEIGHT 40
ACTION Cleaner1()
CAPTION "&Cleaner-1"
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Clean Ink Only"
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
DEFINE BUTTON Button_Clea2
ROW 346
COL 136
WIDTH 111
HEIGHT 40
ACTION Cleaner2()
CAPTION "&Cleaner-2"
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Cleaner Ink and Editor"
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
DEFINE BUTTON Button_Exit
ROW 346
COL 283
WIDTH 232
HEIGHT 40
ACTION ThisWindow.Release
CAPTION "&Exit"
FONTNAME "Arial"
FONTSIZE 12
TOOLTIP "Exit"
ONGOTFOCUS Nil
ONLOSTFOCUS Nil
FLAT .F.
TABSTOP .T.
VISIBLE .T.
TRANSPARENT .F.
MULTILINE .F.
PICTURE Nil
PICTALIGNMENT TOP
END BUTTON
END WINDOW
CENTER WINDOW InkMain
ACTIVATE WINDOW InkMain
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure DoInitInk()
*+
*+ Called from ( hbink.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE DoInitInk()
LOCAL nHwnd
#ifdef Use_Label
nHwnd := GetControlHandle( "Label_1", "InkMain" )
#else
nHwnd := GetControlHandle( "Image_1", "InkMain" )
#endif
// Create the recognizers collection
myRecognizers := CreateObject( "msinkaut.InkRecognizers" )
// Create a new ink collector that uses the Frame's window
myInkCollector := CreateObject( "msinkaut.InkCollector" )
myInkCollector:hWnd := nHwnd
// Turn the ink collector on
myInkCollector:Enabled = .T.
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure RecognizeInk()
*+
*+ Called from ( hbink.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE RecognizeInk()
LOCAL nHwnd := GetControlHandle( "Edit_1", "InkMain" )
LOCAL cString
// Check to ensure that the user has at least one recognizer installed
// Note that this is a preventive check - otherwise, an exception will
// occur during recognition
IF 0 == myRecognizers:Count
MsgInfo( "There are no handwriting recognizers installed." + CRLF + ;
"You need to have at least one in order to run this sample." )
ELSE
// Note that the Strokes' ToString() method is a
// shortcut for retrieving the best match using the
// default recognizer. The same result can also be
// obtained using the RecognizerContext.
//
cString := myInkCollector:Ink:Strokes:ToString()
SetProperty( "InkMain", "Edit_1", "Value", cString )
// If the mouse is pressed, do not perform the recognition -
// this prevents deleting a stroke that is still being drawn
* ? wrong ? * IF .NOT. myInkCollector:CollectingInk
IF myInkCollector:CollectingInk
// Delete the ink from the ink collector
myInkCollector:Ink:DeleteStrokes( myInkCollector:Ink:Strokes )
// Force the Frame to redraw (so the deleted ink will go away)
InvalidateRect( nHwnd, 0 )
ENDIF
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Procedure SaveInk()
*+
*+ Called from ( hbink.prg ) 1 - procedure main()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE SaveInk()
LOCAL oInk
Contador_2()
ALTD()
oInk := myInkCollector:Ink
IF hb_IsObject( oInk )
IF oInk:Strokes:Count > 0
StrFile ( oInk:Save( IPF_GIF, IPCM_Default ), cFileName )
MsgInfo("Save " + cFileName)
dbCloseAll()
SELECT 1
USE CapNum
UNLOCK ALL
IF CAPNUM->REC1 == 99999
CapNum->( FLOCK() )
IF CapNum->( RLOCK() )
REPLACE CAPNUM->REC1 WITH 1
REPLACE CAPNUM->REC2 WITH ALLTRIM( STRZERO( CAPNUM->REC1 ,5 ) )
REPLACE CAPNUM->DATE WITH DATE()
REPLACE CAPNUM->HORA WITH TIME()
CapNum->( dbCOMMIT() )
ENDIF
UNLOCK ALL
ELSE
CapNum->( FLOCK() )
IF CapNum->( RLOCK() )
REPLACE CAPNUM->REC1 WITH CAPNUM->REC1 + 1
REPLACE CAPNUM->REC2 WITH ALLTRIM( STRZERO( CAPNUM->REC1 ,5 ) )
REPLACE CAPNUM->DATE WITH DATE()
REPLACE CAPNUM->HORA WITH TIME()
CapNum->( dbCOMMIT() )
ENDIF
UNLOCK ALL
ENDIF
ELSE
MsgInfo ( "No Strokes" )
ENDIF
ELSE
MsgInfo( "no Ink Object" )
ENDIF
RETURN
*+ EOF: HBINK.PRG
*----------------------------------------------*
PROCEDURE Cleaner1()
*----------------------------------------------*
LOCAL cString
DoInitInk()
InkMain.Label_1.Value := " "
cString := myInkCollector:Ink:Strokes:ToString()
SetProperty( "InkMain", "Label_1", "Value", cString )
Return
*----------------------------------------------*
PROCEDURE Cleaner2()
*----------------------------------------------*
LOCAL cString
DoInitInk()
RecognizeInk()
InkMain.Label_1.Value := " "
cString := myInkCollector:Ink:Strokes:ToString()
SetProperty( "InkMain", "Label_1", "Value", cString )
Return
*----------------------------------------------*
PROCEDURE Contador_1()
*----------------------------------------------*
aStruct := { ;
{ "REC1" , "N", 5, 0 }, ;
{ "REC2" , "C", 5, 0 }, ;
{ "DATE" , "D", 8, 0 }, ;
{ "HORA" , "C", 8, 0 } ;
}
DbCreate( "CapNum", aStruct, .T. )
dbCloseAll()
SELECT 1
USE CapNum
UNLOCK ALL
CapNum->( FLOCK() )
IF CapNum->( RLOCK() )
ZAP
dbAppend()
REPLACE CAPNUM->REC1 WITH 1
REPLACE CAPNUM->REC2 WITH STRZERO( CAPNUM->REC1 ,5)
REPLACE CAPNUM->DATE WITH DATE()
REPLACE CAPNUM->HORA WITH TIME()
CapNum->( dbCOMMIT() )
ENDIF
UNLOCK ALL
numeroQ := ALLTRIM( CAPNUM->REC2 )
cFileName := "Organize\" + numeroQ + miraS
Return
*----------------------------------------------*
PROCEDURE Contador_2()
*----------------------------------------------*
UNLOCK ALL
SELECT 1
USE CapNum
dbGoTop()
IF CAPNUM->REC1 == 0
dbCloseAll()
FileDelete("CapNum.dbf")
Contador_1()
ENDIF
numeroQ := ALLTRIM( CAPNUM->REC2 )
cFileName := "Organize\"+ numeroQ + miraS
Return
*---------------------------------------------------------*
FUNCTION Busca_Format()
*---------------------------------------------------------*
DO CASE
CASE InkMain.Radio_1.Value == 1
miraS := ALLTRIM('.Gif')
CASE InkMain.Radio_1.Value == 2
miraS := ALLTRIM('.Jpg')
CASE InkMain.Radio_1.Value == 3
miraS := ALLTRIM('.Png')
CASE InkMain.Radio_1.Value == 4
miraS := ALLTRIM('.Bmp')
OTHERWISE
ENDCASE
RETURN(.F.)
Regards, Regards, Salam
Mustafa