bb.donnay-software.com

Code: Select all

PROCEDURE DirEval( cWorkPath, cMask, bBlock )
LOCAL aDIR
LOCAL nLEN
LOCAL nCount

   aDIR := DIRECTORY( cWorkPath + "*.*", "D" )

   nLEN := LEN( aDIR )
   FOR nCount := 1 TO nLEN
      IF "D" $ aDIR[ nCount, F_ATTR ] .AND. .NOT. ;
             ( aDIR[ nCount, F_NAME ] = "." .OR. ;
               aDIR[ nCount, F_NAME ] = ".." )

         DirEval( cWorkPath + aDIR[ nCount, F_NAME ] + "\", cMask, bBlock )
      ELSE
         EVAL( bBlock, cWorkPath, aDIR[ nCount, F_NAME ] )
      ENDIF
   NEXT

RETURN

Code: Select all

   cWorkPath = M_ApplsPath+"\Inp_data\"
   
   aAll := DIRECTORY( cWorkPath + "*.*", 'D' )             // Почему-то в массив попадает информация не только по директориям

   IF LEN(aAll) = 0
      Mess = " В папке: "+cWorkPath+" нет файлов!"
      LB_Warning(Mess, "Оцифровка изображений по всем пикселям" )
      RETURN nil
   ENDIF

*  DC_DebugQout( aAll )

   aDir := {}

   FOR j = 1 TO LEN(aAll)
       IF aAll[j, 5] = "D"
       IF aAll[j, 5] <> '.'
       IF aAll[j, 5] <> '..'
          AADD(aDir, aAll[j, 1])
       ENDIF
       ENDIF
       ENDIF
   NEXT

*  DC_DebugQout( aDIR )

   aFileName := {}

   IF LEN(aDIR) = 0
      Mess = " В папке: "+cWorkPath+" нет поддиректорий!"
      LB_Warning(Mess, "Оцифровка изображений по всем пикселям" )
      RETURN nil
   ENDIF

   FOR j = 1 TO LEN(aDIR)
       aFNbmp = DIRECTORY( cWorkPath + aDIR[j] + "\*.bmp" )
       IF LEN(aFNbmp) > 0
          FOR f = 1 TO LEN(aFNbmp)
              AADD(aFileName, cWorkPath + aDIR[j] + "\" + aFNbmp[f,1] )
          NEXT
       ENDIF
       aFNjpg = DIRECTORY( cWorkPath + aDIR[j] + "\*.jpg" )
       IF LEN(aFNjpg) > 0
          FOR f = 1 TO LEN(aFNjpg)
              AADD(aFileName, cWorkPath + aDIR[j] + "\" + aFNjpg[f,1] )
          NEXT
       ENDIF
   NEXT

*  DC_DebugQout( aFileName )

Code: Select all

LOCAL i, j, nXSize := Len(aPixel), nYSize := Len(aPixel[1])

Code: Select all

   *** Определение области изображения

   mX1 = +99999     // x1,y2 ----------- x2,y2
   mY1 = -99999     //       |         |       
   mX2 = -99999     //       |         |
   mY2 = +99999     // x1,y1 ----------- x2,y1

   FOR mImg = 1 TO LEN(aFileName)

       @ 0,0 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP ;
             CAPTION aFileName[mImg] ;
             OBJECT oStatic1 ;
             PREEVAL {|o|o:autoSize := .t.} ;
             EVAL {|o|hDC1 := GetWindowDC(o:getHWnd()), ;
                    o:motion := {|a,b,o|ShowColor( hDC1, a, oSay, o )}, ;
                    aPixel := Array(o:caption:xSize,o:caption:ySize)}

       @ 0,250 DCSTATIC TYPE XBPSTATIC_TYPE_BITMAP;
               CAPTION aFileName[mImg] ;
               PREEVAL {|o|o:autoSize := .t.} ;
               OBJECT oStatic2 ;
               EVAL {|o|hDC2 := GetWindowDC(o:getHWnd())}


       aXY = Trimming(hDC1, hDC2, aPixel)

       mX1 = MIN(mX1, aXY[1])        // Координаты границ области изображения всех символов
       mY1 = MAX(mY1, aXY[2])
       mX2 = MAX(mX2, aXY[3])
       mY2 = MIN(mY2, aXY[4])
   NEXT

Code: Select all

FUNCTION Trimming(hDC1, hDC2, aPixel)

LOCAL i, j, nXSize := Len(aPixel), nYSize := Len(aPixel[1])

   fColor := AutomationTranslateColor(GraMakeRGBColor({255,0,0}),.f.) 

   *** Определить координаты левой границы области отображения X1

   X1 = +9999999
   FOR x = 1 TO nXSize
       mPixOld = GetPixel(hDC1, x-1, 0)
       FOR y = 1 TO nYSize
           mPixNew = GetPixel(hDC1, x-1, y-1)
*          MsgBox("x="+STR(x)+", y="+STR(y)+",  mPix="+STR(mPix))
           IF mPixNew <> mPixOld
              X1 = MIN(X1,x)
*             GraMarker  ( oPS, { x-1, y-1 } )
              SetPixel(hDC2, x-1, y-1, fColor)
              EXIT
           ENDIF
       NEXT
   NEXT

   *** Определить координаты правой границы области отображения X2

   X2 = -9999999
   FOR x = nXSize TO 1 STEP -1
       mPixOld = GetPixel(hDC1, x-1, 0)
       FOR y = 1 TO nYSize
           mPixNew = GetPixel(hDC1, x-1, y-1)
           IF mPixNew <> mPixOld
              X2 = MAX(X2,x)
*             GraMarker  ( oPS, { x-1, y-1 } )
              SetPixel(hDC2, x-1, y-1, fColor)
              EXIT
           ENDIF
       NEXT
   NEXT

   *** Определить координаты верхней границы области отображения Y1

   Y1 = +9999999
   FOR y = 1 TO nYSize
       mPixOld = GetPixel(hDC1, 0, y-1)
       FOR x = 1 TO nXSize
           mPixNew = GetPixel(hDC1, x-1, y-1)
           IF mPixNew <> mPixOld
              Y1 = MIN(Y1,y)
*             GraMarker  ( oPS, { x-1, y-1 } )
              SetPixel(hDC2, x-1, y-1, fColor)
              EXIT
           ENDIF
       NEXT
   NEXT

   *** Определить координаты нижней границы области отображения Y2

   Y2 = -9999999
   FOR y = nYSize TO 1 STEP -1
       mPixOld = GetPixel(hDC1, 0, y-1)
       FOR x = 1 TO nXSize
           mPixNew = GetPixel(hDC1, x-1, y-1)
           IF mPixNew <> mPixOld
              Y2 = MAX(Y2,y)
*             GraMarker  ( oPS, { x-1, y-1 } )
              SetPixel(hDC2, x-1, y-1, fColor)
              EXIT
           ENDIF
       NEXT
   NEXT

   *** Нарисовать прямоугольник области отображения символов с синими границами

   IF X1 > 0 .AND. Y2 > 0 .AND. X2 > 0 .AND. Y2 > 0

*     GraSetColor( oPS, GRA_CLR_RED, GRA_CLR_RED )
*     GraBox( oPS, { X1, Y1 }, { X2, Y2 }, GRA_OUTLINE ) 
*     GraSetColor( oPS, GRA_CLR_BLACK, GRA_CLR_BLACK )

*     cFileName = "All_images.bmp"
*     ERASE( cFileName );DC_Scrn2ImageFile( oStatic, cFileName )            // Стереть старый файл и записать новый

*     MsgBox("{X1="+ALLTRIM(STR(X1))+", Y1="+ALLTRIM(STR(Y1))+"}, {X2="+ALLTRIM(STR(X2))+", Y2="+ALLTRIM(STR(Y2))+"}")

      fColor := AutomationTranslateColor(GraMakeRGBColor({0,0,255}),.f.) 

      FOR x=X1 TO X2
          SetPixel(hDC2, x-1, Y1-1, fColor)
      NEXT
      FOR x=X1 TO X2
          SetPixel(hDC2, x-1, Y2+1, fColor)
      NEXT
      FOR y=Y1 TO Y2
          SetPixel(hDC2, X1-2, y-1, fColor)
      NEXT
      FOR y=Y1 TO Y2
          SetPixel(hDC2, X2+1, y-1, fColor)
      NEXT

  ENDIF

  PRIVATE aXY[4]

  aXY[1] = X1
  aXY[2] = Y1
  aXY[3] = X2
  aXY[4] = Y2

RETURN(aXY)

Code: Select all

   cMask    := "*.JPG"
   DirEval( "d:\Bilder\Guzzi\", "*.*", { | x, y | EvalEachFile( x, y , cMask) } )

   cMask    := "*.BMP"
   DirEval( "d:\Bilder\Guzzi\", "*.*", { | x, y | EvalEachFile( x, y , cMask) } )
   ...

FUNCTION EvalEachFile( ccPath, ccFile, cMask )
   IF "*." $ cMask
      cMask := StrTran(cMask,"*.",".")
   ENDIF

   IF UPPER(cMask) $ UPPER(ccFile)
      // only add Path and F_NAME
      AADD(aAllFiles,{ccPath+ccFile})
   ENDIF
RETURN NIL