GraGradient() with the assignment of the color gradations

[Eugene Lutsenko]

Function GraGradient() ensures a smooth gradient fill color by color triangle at the vertices.
And if there is an option of this function, set the number of gradations of color?

[Auge_Ohr]

And if there is an option of this function, set the number of gradations of color?

as Help File say max 3 Color

Code: Select all

{<xColor1>,<xColor2>,<xColor3>}

[Eugene Lutsenko]

This I know from you the same and are widely used. By the way, thank you, I am very satisfied. But I ask about something else. The standard treatment for this feature results in the smooth play of colors between the vertices. And I ask, is it possible to make it a step and specify the number of stages (gradations) color. Let's say 32 to set the color gradation. Then, when the Delaunay triangulation are obtained borders between colors, such as contour lines (I think).

[Eugene Lutsenko]

I figured out how to do it. I will do - show

[Eugene Lutsenko]

I did zoning color images, including obtained by a Delaunay triangulation.
Full real code in the archive. Function F4_8().
Options allow you to visualize all this and without ribs.
You can also find the border color zones (circuits).

Code: Select all

**************************************************
******** Цветовое зонирование изображения ********
**************************************************
******** Заменить оригинальные цвета всех пикселей
******** интервальными значениями цветов
**************************************************
FUNCTION ColorZone(hDC1,aPixel)

LOCAL GetList[0], GetOptions, oSay, oDialog, oProgress, oScrn

LOCAL i, j, nXSize := Len(aPixel), nYSize := Len(aPixel[1])
LOCAL hMemoryDC := CreateMemoryDC( hDC1, nXSize, nYSize )   // Для ускорения работы GetPixel() примерно в 50 раз

LOCAL Xc, Yc, Nc
LOCAL oBitmap

******************************************************************
*** Изображения для цветового зонирования брать из папкки Inp_data
******************************************************************

   PUBLIC AllColor  := 1         // 1 - Одинаковое для всех цветов, 2 - Для каждого цвета свое

   PUBLIC N_interv  := 8         // Число яркостных интервалов всех цветов
   PUBLIC N_intervR := 8         // Число яркостных интервалов красного цвета
   PUBLIC N_intervG := 8         // Число яркостных интервалов зеленого цвета
   PUBLIC N_intervB := 8         // Число яркостных интервалов синего   цвета


   @  0, 0 DCGROUP oGroup1  CAPTION 'Задайте число цветовых зон:'         SIZE 67.0, 7.0
   @1.5, 2 DCRADIO AllColor VALUE  1 PROMPT 'Одинаковое для всех цветов:' PARENT oGroup1
   @2.5, 2 DCRADIO AllColor VALUE  2 PROMPT 'Для каждого цвета RGB свое:' PARENT oGroup1

   @0.8,40 DCGROUP oGroup2  CAPTION 'Число цветовых зон:' SIZE 25, 2.5    PARENT oGroup1 HIDE {||.NOT.AllColor=1}
   @1  , 1 DCSAY 'RGB:    ' GET N_interv  PICTURE "##########"            PARENT oGroup2 EDITPROTECT {||.NOT.AllColor=1} HIDE {||.NOT.AllColor=1}

   @1.8,40 DCGROUP oGroup2  CAPTION 'Число цветовых зон:' SIZE 25, 4.5    PARENT oGroup1 HIDE {||.NOT.AllColor=2}
   @1  , 1 DCSAY 'Red:    ' GET N_intervR PICTURE "##########"            PARENT oGroup2 EDITPROTECT {||.NOT.AllColor=2} HIDE {||.NOT.AllColor=2}
   @2  , 1 DCSAY 'Green:  ' GET N_intervG PICTURE "##########"            PARENT oGroup2 EDITPROTECT {||.NOT.AllColor=2} HIDE {||.NOT.AllColor=2}
   @3  , 1 DCSAY 'Blue:   ' GET N_intervB PICTURE "##########"            PARENT oGroup2 EDITPROTECT {||.NOT.AllColor=2} HIDE {||.NOT.AllColor=2}

   Pausa = 1
   mMess = 'Делать ли паузу после вывода изображений?'
   @7.5, 0 DCGROUP oGroup3  CAPTION mMess                                 SIZE 67.0, 3.5
   @1  , 2 DCRADIO Pausa VALUE  1 PROMPT 'Нет'                            PARENT oGroup3
   @2  , 2 DCRADIO Pausa VALUE  2 PROMPT 'Да'                             PARENT oGroup3

   @1  ,40 DCPUSHBUTTON CAPTION  'Пояснения по режиму'    SIZE 25, 1.8 ACTION {||Help48()} PARENT oGroup3

   DCGETOPTIONS TABSTOP
   DCREAD GUI ;
      TO lExit ;
      FIT ;
      OPTIONS GetOptions ;
      ADDBUTTONS;
      MODAL ;
      TITLE '4.8. Геокогнитивная подсистема "Эйдос". Цветовые зоны'

      ********************************************************************
      IF lExit
         ** Button Ok
      ELSE
         RETURN NIL
      ENDIF
      ********************************************************************

IF AllColor = 1           // 1 - Одинаковое для всех цветов, 2 - Для каждого цвета свое

   N_intervR = N_interv   // Число яркостных интервалов красного цвета
   N_intervG = N_interv   // Число яркостных интервалов зеленого цвета
   N_intervB = N_interv   // Число яркостных интервалов синего   цвета

ENDIF

IF N_intervR < 2 .OR. N_intervG < 2 .OR. N_intervB < 2
   LB_Warning('Число цветовых зон должно быть больше 1','4.8. Геокогнитивная подсистема "Эйдос"')
   RETURN NIL
ENDIF


**************************************************************************
*** ИСПОЛНЕНИЕ
**************************************************************************

ClearImageTr()

*** Определение путей на файлы изображений символов

*** Сформировать массив наименований папок и в каждой из них массив полных имен графических файлов

   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 := {}           // Массив полных   имен файлов изображений
   aFileNmSh := {}           // Массив коротких имен файлов изображений

   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] )
              AADD(aFileNmSh, 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] )
              AADD(aFileNmSh, aFNjpg[f,1] )
          NEXT
       ENDIF
   NEXT

*  DC_DebugQout( aFileName )
*  DC_DebugQout( aFileNmSh )

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

   *** Если БД "Image.dbf" нет, то создать ее
   IF .NOT. FILE("Image.dbf")
      GenDBFImage()
   ENDIF

*  Записать массив полных имен файлов изображений, а потом считать и использовать его

   DC_ASave(aFileName, "_FileName.arx")
*  DC_DebugQout( aFileNmSh )
*  aFileName := DC_ARestore("_FileName.arx")

*  DC_DebugQout( aFileNmSh )
   DC_ASave(aFileNmSh, "_FileNmSh.arx")
*  aFileNmSh := DC_ARestore("_FileNmSh.arx")
*  DC_DebugQout( aFileNmSh )
*  MsgBox('STOP')


*****************************************************************************************************
** БЕЛЫЙ ЦВЕТ ПИКСЕЛЕЙ ИГНОРИРОВАТЬ, СЧИТАТЬ НЕ ЗНАЧИМЫМ (ФОНОМ), Т.Е. ЗНАЧИМЫЕ ТОЧКИ НЕ БЕЛОГО ЦВЕТА
*****************************************************************************************************

** Имя графического файла для рисования - источника исходных данных

DO CASE
   CASE FILE('Delone.bmp')
        mFileName = 'Delone.bmp'
   CASE FILE('Delone.jpg')
        mFileName = 'Delone.jpg'    // Нежелательно, т.к. изображение размыто
   OTHERWISE
        LB_Warning( 'В текущей папке системы должен быть файл: "Delone.bmp" или "Delone.jpg"','4.8. Геокогнитивная подсистема "Эйдос"' )
        RETURN nil
ENDCASE

********************************************************************************
GenDBFImage()        // 1. Пересоздать (стереть) БД для изображений: "Image.Dbf"
********************************************************************************
CreateImages()       // 2. Оцифровать изображения и записать их в БД "Image.Dbf"
********************************************************************************

nWidthMax  = VAL(FileStr('_WidthMax.txt'))
nHeightMax = VAL(FileStr('_HeightMax.txt'))

***** Определение максимального размера изображения

oScrn := DC_WaitOn( 'Определение максимального размера изображения' )

CLOSE ALL
USE Image VIA 'FOXCDX' EXCLUSIVE NEW

nFNLen = -999999999
nXSize = -999999999
nYSize = -999999999

aFileNmSh := {}

DO WHILE !IMAGE->(Eof())

  aPixel := Bin2Var(IMAGE->array)                  // Загрузка массива из БД Image

  AADD(aFileNmSh, FIELDGET(2))                     // Для формирования имен классов. Вместо записи и считывания массива использовать БД

  nXSize = MAX(nXSize, Len(aPixel))
  nYSize = MAX(nYSize, Len(aPixel[1]))

  nFNLen = MAX(nFNLen, LEN(ALLTRIM(IMAGE->image_name)))

  IMAGE->(dbSkip())

ENDDO
DC_Impl(oScrn)

 StrFile(STR(nXSize,9)+' '+STR(nYSize,9), '_XYSize.txt')          // Запись текстового файла с параметрами nXSize, nYSize
*nXSize = VAL(SUBSTR(FileStr('_XYSize.txt'), 1,9))                // Загрузка параметра nXSize из текстового файла
*nYSize = VAL(SUBSTR(FileStr('_XYSize.txt'),11,9))                // Загрузка параметра nYSize из текстового файла

IF nXSize > 400
   LB_Warning( 'Желательно, чтобы размеры изображений по X были не больше 400 pix !!!','4.8. Геокогнитивная подсистема "Эйдос"' )
ENDIF
IF nYSize > 350
   LB_Warning( 'Желательно, чтобы размеры изображений по Y были не больше 350 pix !!!','4.8. Геокогнитивная подсистема "Эйдос"' )
ENDIF


******************************

DIRCHANGE("AID_DATA")              // Перейти в папку со всеми БД: AID_DATA
IF FILEDATE("Out_data",16) = CTOD("//")
   DIRMAKE("Out_data")
ELSE
   ZapDir ("Out_data", .T.)
   DIRMAKE("Out_data")
ENDIF
DIRCHANGE(Disk_dir)                // Перейти в папку с системой Эйдос


   ********** Создать БД ColorZone.dbf *************
  aStructure := { { "Image_name", "C", nFNLen, 0 },;    // Полное имя файла
                  { "pX"        , "N",     15, 7 },;
                  { "pY"        , "N",     15, 7 },;
                  { "pRedMin"   , "N",     15, 7 },;
                  { "pRed"      , "N",      3, 0 },;
                  { "pRedMax"   , "N",     15, 7 },;
                  { "pGreenMin" , "N",     15, 7 },;
                  { "pGreen"    , "N",      3, 0 },;
                  { "pGreenMax" , "N",     15, 7 },;
                  { "pBlueMin"  , "N",     15, 7 },;
                  { "pBlue"     , "N",      3, 0 },;
                  { "pBlueMax"  , "N",     15, 7 } }
  DbCreate( "ColorZone.dbf", aStructure )


CLOSE ALL
USE ColorZone          EXCLUSIVE NEW
USE Image VIA 'FOXCDX' EXCLUSIVE NEW

N_Image = RECCOUNT()


X_Max = 1820
Y_Max =  910

SELECT Image

DBGOTOP()
DO WHILE .NOT. EOF()

   ClearImageTr()

   mFileName = ALLTRIM(IMAGE->image_name)

*  oScrn := DC_WaitOn( 'Цветовое зонирование файла: "'+mFileName+'"'+'      N'+ALLTRIM(STR(RECNO()))+'/'+ALLTRIM(STR(RECCOUNT())))

   aPixel := Bin2Var(IMAGE->array)                    // Загрузка массива из БД Image

   nXSizeAr = Len(aPixel)
   nYSizeAr = Len(aPixel[1])

   ***********************************************************************************
   **** Нарисовать оригинальные RGB-изображение и изображения в лучах Red, Green, Blue
   ***********************************************************************************
 
   ClearImageTr()

   ***** Расчет позиций для четырех равных по X полей изображений шириной nXSizeAr
   ***** расчет позиций для двух    равных по Y полей изображений шириной nYSizeAr
   ***** и пяти равных промежутков между ними d и слева и справа от изображений до края окна

   X_Max = 1820                                       // Размеры окна изображения
   Y_Max =  910

   dx  = (X_Max-4*nXSizeAr)/5                         // Расстояние между полями изображений и слева и справа до края окна
   dy  = (Y_Max-2*nYSizeAr)/3                         // Расстояние между полями изображений и слева и справа до края окна

   dX1 = 1*dx+0*nXSizeAr                              // Расстояние по X до края поля 1-го изображения
   dX2 = 2*dx+1*nXSizeAr                              // Расстояние по X до края поля 2-го изображения
   dX3 = 3*dx+2*nXSizeAr                              // Расстояние по X до края поля 3-го изображения
   dX4 = 4*dx+3*nXSizeAr                              // Расстояние по X до края поля 4-го изображения

   dY1 = Y_Max-1*dy-0*nYSizeAr - 30                   // Расстояние по Y до края поля 1-го изображения
   dY2 = Y_Max-2*dy-1*nYSizeAr - 30                   // Расстояние по Y до края поля 2-го изображения

   *******************************

   ****** Надпись изображения *********************

   oFont := XbpFont():new():create('18.Arial Bold')
   GraSetFont(oPS , oFont)                            // установить шрифт
   aAttrF := ARRAY( GRA_AS_COUNT ) 
   aAttrF [ GRA_AS_COLOR      ] := GRA_CLR_BLACK 
   aAttrF [ GRA_AS_HORIZALIGN ] := GRA_HALIGN_CENTER  // Выравнивание символов по горизонтали по центру относительно точки начала вывода
   aAttrF [ GRA_AS_VERTALIGN  ] := GRA_VALIGN_HALF    // Выравнивание символов по вертикали по средней линии относительно точки начала вывода
   GraSetAttrString( oPS, aAttrF )                    // Установить символьные атрибуты

   mTitle = 'Файл изображения: "'+mFileName+'"'+'      N'+ALLTRIM(STR(RECNO()))+'/'+ALLTRIM(STR(RECCOUNT()))
   aTxtPar = DC_GraQueryTextbox(mTitle, oFont)                                    // {101,16} Определяет длину и высоту текста в пикселях для некоторых шрифтов
*  MsgBox("Длина текста в пикселях="+ALLTRIM(STR(aTxtPar[1]))+". Высота текста в пикселях="+ALLTRIM(STR(aTxtPar[2])))
   GraStringAt( oPS, { X_Max/2, Y_Max-aTxtPar[2]-15 }, mTitle)

   mTitle = 'Оригинальные RGB-изображение и изображения в лучах Red, Green, Blue'
   aTxtPar = DC_GraQueryTextbox(mTitle, oFont)                                    // {101,16} Определяет длину и высоту текста в пикселях для некоторых шрифтов
*  MsgBox("Длина текста в пикселях="+ALLTRIM(STR(aTxtPar[1]))+". Высота текста в пикселях="+ALLTRIM(STR(aTxtPar[2])))
   GraStringAt( oPS, { X_Max/2, dY1+dy/4 }, mTitle)

   mTitle = 'Зонированные RGB-изображение и изображения в лучах Red, Green, Blue. Количество цветовых зон:  Red='+ALLTRIM(STR(N_intervR))+',  Green='+ALLTRIM(STR(N_intervG))+',  Blue='+ALLTRIM(STR(N_intervB))

   aTxtPar = DC_GraQueryTextbox(mTitle, oFont)                                    // {101,16} Определяет длину и высоту текста в пикселях для некоторых шрифтов
*  MsgBox("Длина текста в пикселях="+ALLTRIM(STR(aTxtPar[1]))+". Высота текста в пикселях="+ALLTRIM(STR(aTxtPar[2])))
   GraStringAt( oPS, { X_Max/2, dY2+dy/4 }, mTitle)

   ************************************************


   aAttr := Array( GRA_AM_COUNT )                     // Создать массив атрибутов
   aAttr[ GRA_AM_SYMBOL ] := GRA_MARKSYM_DOT          // Задать стиль маркера
   GraSetAttrMarker( oPS, aAttr )                     // Установить атрибуты

   FOR y := 1 TO nYSizeAr
       FOR x := 1 TO nXSizeAr

           nColor = AutomationTranslateColor(aPixel[x,y], .t.)
           aRGB   = GraGetRGBIntensity(nColor)                

           ***** Все цвета
           aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ aRGB[1], aRGB[2], aRGB[3] })  // Задать цвет маркера
           GraSetAttrMarker( oPS, aAttr )                                // Установить атрибуты
           GraMarker  ( oPS, { dX1+x, dY1-y } )

           ***** Red *****
           aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ aRGB[1],0,0 })    // Задать цвет маркера
           GraSetAttrMarker( oPS, aAttr )                                // Установить атрибуты
           GraMarker  ( oPS, { dX2+x, dY1-y } )

           ***** Green ***
           aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ 0,aRGB[2],0 })    // Задать цвет маркера
           GraSetAttrMarker( oPS, aAttr )                                // Установить атрибуты
           GraMarker  ( oPS, { dX3+x, dY1-y } )

           ***** Blue ****
           aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ 0,0,aRGB[3] })    // Задать цвет маркера
           GraSetAttrMarker( oPS, aAttr )                                // Установить атрибуты
           GraMarker  ( oPS, { dX4+x, dY1-y } )

       NEXT
   NEXT

   ***********************************************************************************
   **** Нарисовать зонированные RGB-изображение и изображения в лучах Red, Green, Blue
   ***********************************************************************************

   *** Определить минимальные (не равные нулю) и максимальные яркости лучей
  
   MinRed   = +999999
   MaxRed   = -999999
   MinGreen = +999999
   MaxGreen = -999999
   MinBlue  = +999999
   MaxBlue  = -999999

   FOR y := 1 TO nYSizeAr
       FOR x := 1 TO nXSizeAr
 
           nColor = AutomationTranslateColor(aPixel[x,y], .t.)
           aRGB   = GraGetRGBIntensity(nColor)           // Взаимнообратные операции преобразования формы кодирования цвета в массиве RGB и одним числом
 
           MinRed   = MIN(MinRed  , aRGB[1])
           MaxRed   = MAX(MaxRed  , aRGB[1])
 
           MinGreen = MIN(MinGreen, aRGB[2])
           MaxGreen = MAX(MaxGreen, aRGB[2])
 
           MinBlue  = MIN(MinBlue , aRGB[3])
           MaxBlue  = MAX(MaxBlue , aRGB[3])

       NEXT
   NEXT

*  MsgBox(STR(MinRed)  +STR(MaxRed))
*  MsgBox(STR(MinGreen)+STR(MaxGreen))
*  MsgBox(STR(MinBlue) +STR(MaxBlue))

*  MinRed   = 0
*  MaxRed   = 255
*  MinGreen = 0
*  MaxGreen = 255
*  MinBlue  = 0
*  MaxBlue  = 255


   ******* Расчет массивов начальных и конечных значений цветовых зон (интервалов) для разных цветов

   aMinRed   := {}         // Массив минимальных  значений цветовых интервалов красного цвета
   aMaxRed   := {}         // Массив максимальных значений цветовых интервалов красного цвета

   aMinGreen := {}         // Массив минимальных  значений цветовых интервалов зеленого цвета
   aMaxGreen := {}         // Массив максимальных значений цветовых интервалов зеленого цвета

   aMinBlue  := {}         // Массив минимальных  значений цветовых интервалов синего   цвета
   aMaxBlue  := {}         // Массив максимальных значений цветовых интервалов синего   цвета

   dR = ( MaxRed   - MinRed   ) / N_intervR     // Размер цветового интервала  красного цвета
   dG = ( MaxGreen - MinGreen ) / N_intervG     // Размер цветового интервала  зеленого цвета
   dB = ( MaxBlue  - MinBlue  ) / N_intervB     // Размер цветового интервала  синего   цвета

   FOR j=1 TO N_intervR
       AADD(aMinRed  , MinRed   + (j-1)*dR )
       AADD(aMaxRed  , MinRed   +  j   *dR )
   NEXT

   FOR j=1 TO N_intervG
       AADD(aMinGreen, MinGreen + (j-1)*dG )
       AADD(aMaxGreen, MinGreen +  j   *dG )
   NEXT

   FOR j=1 TO N_intervB
       AADD(aMinBlue , MinBlue  + (j-1)*dB )
       AADD(aMaxBlue , MinBlue  +  j   *dB )
   NEXT

*  DC_ArrayView( aMinRed   )
*  DC_ArrayView( aMaxRed   )
*  DC_ArrayView( aMinGreen )
*  DC_ArrayView( aMaxGreen )
*  DC_ArrayView( aMinBlue  )
*  DC_ArrayView( aMaxBlue  )

   *** Замена оригинальных цветов пикселей средними значениями цветов цветовых зон, в которые они попадают

   FOR y := 1 TO nYSizeAr
       FOR x := 1 TO nXSizeAr
 
*******************************************************************************************************
*          Взаимнообратные операции преобразования формы кодирования цвета в массиве RGB и одним числом
*          nColor = AutomationTranslateColor(aPixel1[x,y], .t.)
*          IF GraIsRGBColor(nColor)                                   // Это цвет?
*             aRGB      = GraGetRGBIntensity(nColor)                
*             nColorPix = GraMakeRGBColor(aRGB)
*             MsgBox(STR(nColor)+STR(nColorPix))                      // nColor === nColorPix
*             aPixel2[x,y] = AutomationTranslateColor(nColorPix,.f.)  // aPixel2[x,y] === aPixel1[x,y] ?
*          ENDIF
*******************************************************************************************************

           nColor = AutomationTranslateColor(aPixel[x,y], .t.)
           aRGB = GraGetRGBIntensity(nColor)           // Взаимнообратные операции преобразования формы кодирования цвета в массиве RGB и одним числом

           mColorPixR = aRGB[1]
           mColorPixG = aRGB[2]
           mColorPixB = aRGB[3]

           mFlagR = .F.
           FOR j=1 TO N_intervR
               IF aMinRed[j]    <= aRGB[1] .AND. aRGB[1] <= aMaxRed[j]
                  mColorPixR = ROUND(aMinRed[j]   + ( aMaxRed[j]   - aMinRed[j] ) / 2,0)         // Среднее значение цвета j-й цветовой зоны красного цвета
                  mMinRed = aMinRed[j]
                  mMaxRed = aMaxRed[j]
                  mFlagR = .T.
                  EXIT
               ENDIF
           NEXT
           mFlagG = .F.
           FOR j=1 TO N_intervG
               IF aMinGreen[j]  <= aRGB[2] .AND. aRGB[2] <= aMaxGreen[j]
                  mColorPixG = ROUND(aMinGreen[j] + ( aMaxGreen[j] - aMinGreen[j] ) / 2,0)       // Среднее значение цвета j-й цветовой зоны зеленого цвета
                  mMinGreen = aMinGreen[j]
                  mMaxGreen = aMaxGreen[j]
                  mFlagG = .T.
                  EXIT
               ENDIF
           NEXT
           mFlagB = .F.
           FOR j=1 TO N_intervB
               IF aMinBlue[j]   <= aRGB[3] .AND. aRGB[3] <= aMaxBlue[j]
                  mColorPixB = ROUND(aMinBlue[j] + ( aMaxBlue[j]   - aMinBlue[j]  ) / 2,0)       // Среднее значение цвета j-й цветовой зоны синего цвета
                  mMinBlue = aMinBlue[j]
                  mMaxBlue = aMaxBlue[j]
                  mFlagB = .T.
                  EXIT
               ENDIF
           NEXT

*          MsgBox('Исходные цвета:     '+STR(aRGB[1],3)   +STR(aRGB[2],3)   +STR(aRGB[3],3))
*          MsgBox('Зонированные цвета: '+STR(mColorPixR,3)+STR(mColorPixG,3)+STR(mColorPixB,3))

*          mColorPixR = aRGB[1]
*          mColorPixG = aRGB[2]
*          mColorPixB = aRGB[3]

           **** Записать данные об изображении

           IF mFlagR .AND. mFlagG .AND. mFlagB

              ***** Все цвета
              aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ mColorPixR, mColorPixG, mColorPixB })     // Задать цвет маркера
              GraSetAttrMarker( oPS, aAttr )                                   // Установить атрибуты
              GraMarker  ( oPS, { dX1+x, dY2-y } )

              ***** Red *****
              aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ mColorPixR,0,0 })    // Задать цвет маркера
              GraSetAttrMarker( oPS, aAttr )                                   // Установить атрибуты
              GraMarker  ( oPS, { dX2+x, dY2-y } )

              ***** Green ***
              aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ 0,mColorPixG,0 })    // Задать цвет маркера
              GraSetAttrMarker( oPS, aAttr )                                   // Установить атрибуты
              GraMarker  ( oPS, { dX3+x, dY2-y } )

              ***** Blue ****
              aAttr[ GRA_AL_COLOR ]  := GraMakeRGBColor({ 0,0,mColorPixB })    // Задать цвет маркера
              GraSetAttrMarker( oPS, aAttr )                                   // Установить атрибуты
              GraMarker  ( oPS, { dX4+x, dY2-y } )


*             ********** Создать БД ColorZone.dbf **************
*             aStructure := { { "Image_name", "C", nFNLen, 0 },;    // Полное имя файла
*                             { "pX"        , "N",     15, 7 },;
*                             { "pY"        , "N",     15, 7 },;
*                             { "pRedMin"   , "N",     15, 7 },;
*                             { "pRed"      , "N",      3, 0 },;
*                             { "pRedMax"   , "N",     15, 7 },;
*                             { "pGreenMin" , "N",     15, 7 },;
*                             { "pGreen"    , "N",      3, 0 },;
*                             { "pGreenMax" , "N",     15, 7 },;
*                             { "pBlueMin"  , "N",     15, 7 },;
*                             { "pBlue"     , "N",      3, 0 },;
*                             { "pBlueMax"  , "N",     15, 7 } }
*             DbCreate( "ColorZone.dbf", aStructure )

              SELECT ColorZone
              APPEND BLANK
              REPLACE Image_name WITH mFileName
              REPLACE pX         WITH x
              REPLACE pY         WITH y

              REPLACE pRedMin    WITH mMinRed
              REPLACE pRed       WITH mColorPixR
              REPLACE pRedMax    WITH mMaxRed

              REPLACE pGreenMin  WITH mMinGreen
              REPLACE pGreen     WITH mColorPixG
              REPLACE pGreenMax  WITH mMaxGreen

              REPLACE pBlueMin   WITH mMinBlue
              REPLACE pBlue      WITH mColorPixB
              REPLACE pBlueMax   WITH mMaxBlue

           ENDIF
       NEXT
   NEXT

*  DC_Impl(oScrn)


   ******* Запись изображения

   Pos = RAT("\",mFileName)
   IF Pos > 0
      cFileName = ConvToAnsiCP(SUBSTR(mFileName, Pos+1, LEN(mFileName)-Pos))  // Получилось
   ELSE
      cFileName = ConvToAnsiCP(ALLTRIM(mFileName))  // Получилось
   ENDIF
   IF FILE (cFileName)
      ERASE(cFileName)
   ENDIF
   cFileName = SUBSTR(cFileName,1,LEN(cFileName)-4)+'-RGB_ColZone.bmp'
*  WTF oStatic PAUSE            // Отладка
   DC_Scrn2ImageFile( oStatic1, cFileName )

   ******* Копирование изображения в папку для выходных изображений 

   Name_SS = Disk_dir +"/"+cFileName
   Name_DD = M_ApplsPath+"\Out_data\"+cFileName
   COPY FILE (Name_SS) TO (Name_DD)

   ERASE(cFileName)

   IF Pausa=2;MILLISEC(5000);ENDIF

   SELECT Image
   DBSKIP(1)

ENDDO

RETURN NIL

*------------------------------------

[/size]