Forming an image without displaying it on the screen

Message

Eugene Lutsenko · Fri Oct 19, 2018 12:59 pm

rdonnay wrote:Can't you apply a scaling factor at the time that you are drawing the image?

Hey, Roger!!!

Perhaps this is the easiest and right decision. But I thought to solve the problem in principle. And it will probably be necessary to do so. Eventually, when you get a chance to do it.

Eugene Lutsenko · #12 Post by **Eugene Lutsenko** » Fri Oct 26, 2018 1:41 pm

Is it not possible to emulate a video card and monitor with the necessary permissions? Is it not possible to use a virtual video card and monitor with the desired resolution?

Auge_Ohr · #13 Post by **Auge_Ohr** » Fri Oct 26, 2018 3:57 pm

Eugene Lutsenko wrote:Is it not possible to emulate a video card and monitor with the necessary permissions? Is it not possible to use a virtual video card and monitor with the desired resolution?

to create a (independent) Bitmap you do not need any Video Card ...

as i say you have to use "real" XbpPresSpace() / XbpBitmap():presSpace() and NOT "Micro-Presspace" XbpWindow():lockPS() which depends (!) on Device (e.g. Size)

Code: Select all

   // Create new bitmap with given size
   oPS := XBPPRESSPACE() :new() :Create()
   oBMP := XBPBITMAP() :New() :Create()
   oBMP:Make( aSize[ 1 ], aSize[ 2 ], nPlanes, nBits )
   oBMP:presSpace( oPS )
   
   // here your GRA* Code 

   oBMP:saveFile("MyImage.JPG",XBPBMP_FORMAT_JPG)

Eugene Lutsenko · #14 Post by **Eugene Lutsenko** » Fri Oct 26, 2018 9:18 pm

I will try

Eugene Lutsenko · #15 Post by **Eugene Lutsenko** » Sun Oct 28, 2018 9:02 am

Jimmy!

What are the parameters nPlanes, nBits in bmp:Make( a Size[ 1 ], size[ 2 ], nPlanes, nBits )

Eugene Lutsenko · #16 Post by **Eugene Lutsenko** » Sun Oct 28, 2018 9:12 am

Thank you! It worked! I will apply!

And where to find the function: BMP2BMP(oBMP,aNewSize)

Roger has something similar: SCALEBITMAP. But will it work with very large images?

Code: Select all

     ********************************************************************************
     FUNCTION Main()
     
     DC_IconDefault(1000)

     SET DECIMALS TO 15
     SET DATE GERMAN
     SET ESCAPE On

     // Размеры изображения по X и по Y
     nXSize = 8000
     nYSize = 4000

     oScr := DC_WaitOn('Немного подождите! Идет формирование и масштабирование изображения!')


     // Create new bitmap with given size
     oPS := XBPPRESSPACE() :new() :Create()
     oBMP := XBPBITMAP() :New() :Create()
*    oBMP:Make( nXSize, nYSize, nPlanes, nBits )
     oBMP:Make( nXSize, nYSize )
     oBMP:presSpace( oPS )
     
     // here your GRA* Code 
     
     **** Закрасить фон прямоугольника ***************
*    GraSetColor( oPS, GRA_CLR_WHITE, GRA_CLR_WHITE )
     GraSetColor( oPS, BD_LIGHTGREY, BD_LIGHTGREY )
     GraBox( oPS, { 0, 0 }, { nXSize, nYSize }, GRA_FILL ) 

     ArchimSpiral()                     // Графическая функция
     
     ERASE("MyImage1.JPG")
     oBMP:saveFile("MyImage1.JPG",XBPBMP_FORMAT_JPG)
     
*    aNewSize := {1024,768}
*    BMP2BMP(oBMP,aNewSize)             // Масштабирование изображения
*    oBMP:saveFile("MyImage2.JPG",XBPBMP_FORMAT_JPG) 

     DC_Impl(oScr)                                                   

LB_Warning('Готово!')

CLOSE ALL
RETURN NIL

******************************************************************************************************************
FUNCTION ArchimSpiral()

LOCAL GetList[0], GetOptions, oSay, oDevice
LOCAL aX[100000], aY[100000], aZ[100000]                                         // Координаты X,Y,Z точек облака

ERASE('_ColumnNames.arx');ERASE('_482.txt')    // Стереть файлы: _ColumnNames.arx и _482.txt

AFILL(aX,0)
AFILL(aY,0)
AFILL(aZ,0)

***** Задать атрибуты линии

aAttr := Array( GRA_AL_COUNT )                             // Массив для атрибутов линии  
aAttr [ GRA_AL_TYPE  ] := GRA_LINETYPE_DEFAULT
graSetAttrLine( oPS, aAttr )                  

PointsCount = 10000                        // число точек
TurnovCount =    10                        // число виктов спирали

u = 360 / PointsCount * TurnovCount        // угол между точками


**** Поиск минимальных и максимальных X и Y и нормирование

mMinX = +99999999999
mMaxX = -99999999999
mMinY = +99999999999
mMaxY = -99999999999

i = 0

GradRad := 3.14159265358979323846 / 180    // Коэффициент перевода аргументов тригонометрических функций из градусов в радианы

FOR p=1 TO PointsCount

    mX := i * COS( p*u * GradRad )
    mY := i * SIN( p*u * GradRad )

    i++

    mMinX = MIN(mMinX, mX)
    mMaxX = MAX(mMaxX, mX)
    mMinY = MIN(mMinY, mY)
    mMaxY = MAX(mMaxY, mY)

NEXT

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

X_Max := nXSize
Y_Max := nYSize                                     // Размер графического окна для самого графика в пикселях

IF .NOT. FILE('_XYSize.txt')
*  LB_Warning(L('Необходимо запустить режим генерации облака точек!','4.8. Геокогнитивная подсистема "Эйдос"' )
   StrFile(STR(nXSize,9)+' '+STR(nYSize,9), '_XYSize.txt')          // Запись текстового файла с параметрами nXSize, nYSize
ELSE
*  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 из текстового файла
ENDIF

dX = (X_Max-0.8*Y_Max)/2
dY = (Y_Max-0.8*Y_Max)/2

i = 0

FOR p=1 TO PointsCount

    mX := i * COS( p*u * GradRad )
    mY := i * SIN( p*u * GradRad )

    mZ := p

    i++

    aX[i] =         0.8 * Y_Max * ( mX - mMinX) / (mMaxX - mMinX) + dX
    aY[i] = Y_Max - 0.8 * Y_Max * ( mY - mMinY) / (mMaxY - mMinY) - dY
    aZ[i] =                         mZ

    aAttr [ GRA_AL_COLOR ] := GRA_CLR_RED                  // Задать цвет    линии
    aAttr [ GRA_AL_WIDTH ] := 1                            // Задать толщину линии
    graSetAttrLine( oPS, aAttr )                  
    GraArc ( oPS, { aX[i], aY[i] }, 2 )                    // Рисует круг стилем линии

    aAttr [ GRA_AL_COLOR ] := GRA_CLR_DARKGRAY             // Задать цвет    линии
    aAttr [ GRA_AL_WIDTH ] := 1                            // Задать толщину линии
    graSetAttrLine( oPS, aAttr )                  
    GraArc ( oPS, { aX[i], aY[i] }, 3 )                    // Рисует круг стилем линии

NEXT

PointsCount = i

***** Создать БД для координат X,Y,Z точек облака

aStructure := { { "Num"   , "N",  15, 0 }, ;
                { "pX"    , "N",  15, 7 }, ;
                { "pY"    , "N",  15, 7 }, ;
                { "pZ"    , "N",  15, 7 }, ;
                { "pRed"  , "N",   3, 0 }, ; 
                { "pGreen", "N",   3, 0 }, ; 
                { "pBlue" , "N",   3, 0 }  }
DbCreate( 'Points_XYZ', aStructure )

CLose All

USE Points_XYZ EXCLUSIVE NEW
SELECT Points_XYZ

FOR p=1 TO PointsCount
    
    APPEND BLANK
    REPLACE Num WITH p
    REPLACE pX  WITH aX[p]
    REPLACE pY  WITH aY[p]
    REPLACE pZ  WITH aZ[p]

NEXT

  CLose All

RETURN nil


******** Display a warning message
******** Может выдавать сообщения элементами массива и без ctitle:

*message := {}
*AADD(message,'1-е сообщение')
*AADD(message,'2-е сообщение')
*AADD(message,'3-е сообщение')
*LB_Warning( message )

FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
  DEFAULT cTitle TO ''
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  IF LEN(ALLTRIM(cTitle)) > 0
     DC_MsgBox( ,,aMsg,cTitle)
  ELSE
     DC_MsgBox( ,,aMsg,'(C) Система "Эйдос"')
  ENDIF

RETURN NIL

[/size]

Auge_Ohr · #17 Post by **Auge_Ohr** » Sun Oct 28, 2018 11:15 am

Eugene Lutsenko wrote:Thank you! It worked! I will apply!

And where to find the function: BMP2BMP(oBMP,aNewSize)

Roger has something similar: SCALEBITMAP. But will it work with very large images?

upsize always work well.

as i can say SCALEBITMAP is for Button

here is my Bmp2Bmp() Function.

Code: Select all

FUNCTION BMP2BMP( oBMP, aXbpSize )
LOCAL oHuge
LOCAL oTiny
LOCAL oPS
LOCAL oRet
LOCAL nBits
LOCAL nPlanes

  IF aXbpSize[ 2 ] > 0
      oHuge    := oBMP
      nBits    := oBMP:bits
      nPlanes  := oBMP:planes

      oPS := XBPPRESSPACE() :new():Create()
      oTiny := XBPBITMAP() :New() :Create()
      if nBits > 1 .or. nPlanes > 1
         oTiny:Make( aXbpSize[ 1 ], aXbpSize[ 2 ], nPlanes, nBits )
      ELSE
         oTiny:Make( aXbpSize[ 1 ], aXbpSize[ 2 ] )
      ENDIF
      oTiny:presSpace( oPS )

      oHuge:Draw( oPS, { 0, 0, aXbpSize[1], aXbpSize[2] },,,GRA_BLT_BBO_IGNORE  )
      oRet := oTiny
   ELSE
      oRet := oBMP
   ENDIF

RETURN oRet

Eugene Lutsenko · Sun Oct 28, 2018 11:42 am

Now everything works as it should! Thank You, Jimmy! Thank You, Roger! What is nice that it almost does not require modification of the program. I'll just insert already made and well-working graphical functions instead of the ArchimSpiral function()

Code: Select all

     ********************************************************************************
     FUNCTION Main()
     
     DC_IconDefault(1000)

     SET DECIMALS TO 15
     SET DATE GERMAN
     SET ESCAPE On

     // Размеры изображения по X и по Y
*    nXSize = 4096
*    nYSize = 3072

     nXSize = 1920
     nYSize = 1080

     oScr := DC_WaitOn('Немного подождите! Идет формирование и масштабирование изображения!')

     // Create new bitmap with given size
     oPS := XBPPRESSPACE() :new() :Create()
     oBMP := XBPBITMAP() :New() :Create()
*    oBMP:Make( nXSize, nYSize, nPlanes, nBits )
     oBMP:Make( nXSize, nYSize )
     oBMP:presSpace( oPS )
     
     // here your GRA* Code 
     
     **** Закрасить фон прямоугольника ***************
*    GraSetColor( oPS, GRA_CLR_WHITE, GRA_CLR_WHITE )
     GraSetColor( oPS, BD_LIGHTGREY, BD_LIGHTGREY )
     GraBox( oPS, { 0, 0 }, { nXSize, nYSize }, GRA_FILL ) 

     *######################################################################################################################
     ArchimSpiral()                     // Графическая функция     <<<===###################################################
     *######################################################################################################################

     *My image original, my image scaled
     
     ERASE("MyImageOriginal.JPG")
     oBMP:saveFile("MyImageOriginal.JPG",XBPBMP_FORMAT_JPG)
     
*    aNewSize := {1366,768}             // Новый размер изображения
     ********* Роджер ***********************
     aWorkArea := DC_GetWorkArea()
     nWidth    := aWorkArea[3] - aWorkArea[1]
     nHeight   := aWorkArea[4] - aWorkArea[2]
     aNewSize := {nWidth,nHeight}       // Новый размер изображения
     ****************************************
     oRet = BMP2BMP(oBMP,aNewSize)      // Масштабирование изображения
     ERASE("MyImageScaled.JPG")
     oRet:saveFile("MyImageScaled.JPG",XBPBMP_FORMAT_JPG) 

     DC_Impl(oScr)                                                   

LB_Warning('Готово!')

CLOSE ALL
RETURN NIL

******************************************************************************************************************
FUNCTION ArchimSpiral()

LOCAL GetList[0], GetOptions, oSay, oDevice
LOCAL aX[100000], aY[100000], aZ[100000]                                         // Координаты X,Y,Z точек облака

ERASE('_ColumnNames.arx');ERASE('_482.txt')    // Стереть файлы: _ColumnNames.arx и _482.txt

AFILL(aX,0)
AFILL(aY,0)
AFILL(aZ,0)

***** Задать атрибуты линии

aAttr := Array( GRA_AL_COUNT )                             // Массив для атрибутов линии  
aAttr [ GRA_AL_TYPE  ] := GRA_LINETYPE_DEFAULT
graSetAttrLine( oPS, aAttr )                  

PointsCount = 1000                         // число точек
TurnovCount =   20                         // число виктов спирали

u = 360 / PointsCount * TurnovCount        // угол между точками


**** Поиск минимальных и максимальных X и Y и нормирование

mMinX = +99999999999
mMaxX = -99999999999
mMinY = +99999999999
mMaxY = -99999999999

i = 0

GradRad := 3.14159265358979323846 / 180    // Коэффициент перевода аргументов тригонометрических функций из градусов в радианы

FOR p=1 TO PointsCount

    mX := i * COS( p*u * GradRad )
    mY := i * SIN( p*u * GradRad )

    i++

    mMinX = MIN(mMinX, mX)
    mMaxX = MAX(mMaxX, mX)
    mMinY = MIN(mMinY, mY)
    mMaxY = MAX(mMaxY, mY)

NEXT

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

X_Max := nXSize
Y_Max := nYSize                                     // Размер графического окна для самого графика в пикселях

IF .NOT. FILE('_XYSize.txt')
*  LB_Warning(L('Необходимо запустить режим генерации облака точек!','4.8. Геокогнитивная подсистема "Эйдос"' )
   StrFile(STR(nXSize,9)+' '+STR(nYSize,9), '_XYSize.txt')          // Запись текстового файла с параметрами nXSize, nYSize
ELSE
*  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 из текстового файла
ENDIF

dX = (X_Max-0.8*Y_Max)/2
dY = (Y_Max-0.8*Y_Max)/2

i = 0

FOR p=1 TO PointsCount

    mX := i * COS( p*u * GradRad )
    mY := i * SIN( p*u * GradRad )

    mZ := p

    i++

    aX[i] =         0.8 * Y_Max * ( mX - mMinX) / (mMaxX - mMinX) + dX
    aY[i] = Y_Max - 0.8 * Y_Max * ( mY - mMinY) / (mMaxY - mMinY) - dY
    aZ[i] =                         mZ

    aAttr [ GRA_AL_COLOR ] := GRA_CLR_RED                  // Задать цвет    линии
    aAttr [ GRA_AL_WIDTH ] := 1                            // Задать толщину линии
    graSetAttrLine( oPS, aAttr )                  
    GraArc ( oPS, { aX[i], aY[i] }, 2 )                    // Рисует круг стилем линии

    aAttr [ GRA_AL_COLOR ] := GRA_CLR_DARKGRAY             // Задать цвет    линии
    aAttr [ GRA_AL_WIDTH ] := 1                            // Задать толщину линии
    graSetAttrLine( oPS, aAttr )                  
    GraArc ( oPS, { aX[i], aY[i] }, 3 )                    // Рисует круг стилем линии

NEXT

PointsCount = i

***** Создать БД для координат X,Y,Z точек облака

aStructure := { { "Num"   , "N",  15, 0 }, ;
                { "pX"    , "N",  15, 7 }, ;
                { "pY"    , "N",  15, 7 }, ;
                { "pZ"    , "N",  15, 7 }, ;
                { "pRed"  , "N",   3, 0 }, ; 
                { "pGreen", "N",   3, 0 }, ; 
                { "pBlue" , "N",   3, 0 }  }
DbCreate( 'Points_XYZ', aStructure )

CLose All

USE Points_XYZ EXCLUSIVE NEW
SELECT Points_XYZ

FOR p=1 TO PointsCount
    
    APPEND BLANK
    REPLACE Num WITH p
    REPLACE pX  WITH aX[p]
    REPLACE pY  WITH aY[p]
    REPLACE pZ  WITH aZ[p]

NEXT

  CLose All

RETURN nil

*******************************************************************
******** Масштбалирование bmp-изображения от Джимми
*******************************************************************
FUNCTION BMP2BMP( oBMP, aXbpSize )

LOCAL oHuge
LOCAL oTiny
LOCAL oPS
LOCAL oRet
LOCAL nBits
LOCAL nPlanes

  IF aXbpSize[ 2 ] > 0
      oHuge    := oBMP
      nBits    := oBMP:bits
      nPlanes  := oBMP:planes

      oPS := XBPPRESSPACE() :new():Create()
      oTiny := XBPBITMAP() :New() :Create()
      if nBits > 1 .or. nPlanes > 1
         oTiny:Make( aXbpSize[ 1 ], aXbpSize[ 2 ], nPlanes, nBits )
      ELSE
         oTiny:Make( aXbpSize[ 1 ], aXbpSize[ 2 ] )
      ENDIF
      oTiny:presSpace( oPS )

      oHuge:Draw( oPS, { 0, 0, aXbpSize[1], aXbpSize[2] },,,GRA_BLT_BBO_IGNORE  )
      oRet := oTiny
   ELSE
      oRet := oBMP
   ENDIF

RETURN oRet

******** Display a warning message
******** Может выдавать сообщения элементами массива и без ctitle:

*message := {}
*AADD(message,'1-е сообщение')
*AADD(message,'2-е сообщение')
*AADD(message,'3-е сообщение')
*LB_Warning( message )

FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
  DEFAULT cTitle TO ''
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  IF LEN(ALLTRIM(cTitle)) > 0
     DC_MsgBox( ,,aMsg,cTitle)
  ELSE
     DC_MsgBox( ,,aMsg,'(C) Система "Эйдос"')
  ENDIF

RETURN NIL

[/size]

Auge_Ohr · #19 Post by **Auge_Ohr** » Sun Nov 04, 2018 4:51 pm

i saw that Function BMP2BMP() do not have transparency
here with transparency

Code: Select all

FUNCTION BMP2BMP(oBMP,aXbpSize)
LOCAL oHuge
LOCAL oTiny
LOCAL oPS
LOCAL oRet
LOCAL nbits    := oBMP:bits
LOCAL nplanes  := oBMP:planes
LOCAL nTrans   := oBMP:transparency
LOCAL nBColor  := oBMP:getDefaultBgColor()
LOCAL aRGB

   IF aXbpSize[2] > 0
      oHuge := oBMP
      oPS := XbpPresSpace():new():Create()
      oTiny := XbpBitmap():New()
      oTiny:Create()

      IF nBColor = 16777216
         aRGB := GraGetRGBIntensity(nBColor)
         oTiny:transparentClr := GraMakeRGBColor(aRGB)
      ELSE
         oTiny:transparentClr := oBMP:getDefaultBgColor()
      ENDIF

      oTiny:Make(aXbpSize[1],aXbpSize[2],nplanes,nbits)
      oTiny:presSpace(oPS)

      IF aXbpSize[2] > oBMP:ySize    // Up-size
          oHuge:Draw(oPS,{0,0,aXbpSize[1],aXbpSize[2]},,,GRA_BLT_BBO_IGNORE)
      ELSE
          oHuge:Draw(oPS,{0,0,aXbpSize[1],aXbpSize[2]},,,4)
      ENDIF
      oRet := oTiny
   ELSE
      oRet := oBMP
   ENDIF

RETURN oRet

when Using Windows Color transparency is different
when shrink a Image you can try Diegos Tip with 4 instead GRA_BLT_BBO_* Constante

p.s. Xbase++ can only use 24bit Color

Eugene Lutsenko · Sun Nov 04, 2018 11:06 pm

Visually, the difference in their work is not detected: http://bb.donnay-software.com/donnay/vi ... f=2&t=2485

bb.donnay-software.com

Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen

Re: Forming an image without displaying it on the screen