Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

   ****** Цикл по будущим сценариям *******************************

   SELECT DrawScen
   DBGOTOP()
   DO WHILE .NOT. EOF()

      PUBLIC X_MaxW := 1800, Y_MaxW := 900           // Размер графического окна для отображения когнитивных диаграмм в пикселях
      PUBLIC nXSize := 1800
      PUBLIC nYSize :=  900
      
      oScr := DC_WaitOn('Немного подождите! Идет формирование изображения в памяти и его масштабирование',,,,,,,,,,,.F.)
      
      // 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 ) 
      
      *########################################################################################################################################
      DrawScenario(oPS, Kod, Name, Kod_Sc, N_PointsScenario, mPar)                                         // Графическая функция <<<===#######
      *########################################################################################################################################
      
      *My image original, my image scaled
      
      DC_Impl(oScr)                                                   

      SELECT DrawScen

      DO CASE
         CASE mPar = 'Cls'

              ****** Запись полноразмерного графического файла в папку: M_PathAppl+"\FutureScenarios\"
              DIRCHANGE(M_PathAppl)                                   // Перейти в папку текущего приложения
              IF FILEDATE("FutureScenarios",16) = CTOD("//")
                 DIRMAKE("FutureScenarios")
                 aMess := {}
                 AADD(aMess, L('В папке текущего приложения: "'+UPPER(ALLTRIM(M_PathAppl))+'"'))
                 AADD(aMess, L('не было директории "FutureScenarios" для будущих сценариев и она была создана!'))
                 AADD(aMess, L('В эту папку записываются исходные изображения высокого качества (без масштабирования)'))
                 LB_Warning(aMess, L('2.1. Классификационные шкалы и градации' ))
              ENDIF
              DIRCHANGE(M_PathAppl+"\FutureScenarios\")                  // Перейти в папку Futurecenarios
              cFileName = 'FutureScen'+'-'+ALLTRIM(STRTRAN(STR(Kod,mNRazr),' ','0'))+'-Splain.jpg'

         CASE mPar = 'Atr'

              ****** Запись полноразмерного графического файла в папку: M_PathAppl+"\PastScenarios\"
              DIRCHANGE(M_PathAppl)                                   // Перейти в папку текущего приложения
              IF FILEDATE("PastScenarios",16) = CTOD("//")
                 DIRMAKE("PastScenarios")
                 aMess := {}
                 AADD(aMess, L('В папке текущего приложения: "'+UPPER(ALLTRIM(M_PathAppl))+'"'))
                 AADD(aMess, L('не было директории "PastScenarios" для прошлых сценариев и она была создана!'))
                 AADD(aMess, L('В эту папку записываются исходные изображения высокого качества (без масштабирования)'))
                 LB_Warning(aMess, L('2.2. Описательные шкалы и градации' ))
              ENDIF
              DIRCHANGE(M_PathAppl+"\PastScenarios\")                  // Перейти в папку Futurecenarios
              cFileName = 'PastScen'+'-'+ALLTRIM(STRTRAN(STR(Kod,mNRazr),' ','0'))+'-Splain.jpg'

      ENDCASE
      
      ERASE(cFileName)
      oBMP:SaveFile(cFileName,XBPBMP_FORMAT_JPG)
      
      IF nWidth > 1800
         FullView( cFileName, "по верху", 65 )                // Визуализация полноразмерного файла на мониторе высокого разрешения
      ELSE
         ****** Формирование с помощью bmp2bmp() и отображение масштабированного изображения
         aNewSize := {nWidth,nHeight-29}                      // Новый размер изображения (еще немного уменьшается, чтобы не рисовать по панели задач)
         oBMP:loadFile(cFileName)                             // Загрузка полноразмерного изображения
         oRet := BMP2BMP(oBMP,aNewSize)                       // Масштабирование изображения
         cFileNameScale = SUBSTR(cFileName,1,AT(".jpg",cFileName)-1)+"_scaled.jpg"
         ERASE(cFileNameScale)
         oRet:saveFile(cFileNameScale,XBPBMP_FORMAT_JPG)      // Запись масштабированного графического файла в в папку приложения для визуализации
         FullView( cFileNameScale, "по верху", 0 )            // Визуализация масштабированного графического файла на мониторе ограниченного разрешения
      
      ENDIF
      DIRCHANGE(M_PathAppl)                                   // Перейти в папку текущего приложения

      SELECT DrawScen
      DBSKIP(1)
   ENDDO

Code: Alles auswählen

      DO WHILE nEvent != xbeP_Close
         nEvent := APPEVENT( @mp1, @mp2, @oXbp )
         IF nEvent == xbeP_Keyboard .AND. mp1 == xbeK_ESC
            oDlg:destroy()
            EXIT
         ELSE
            oXbp:HandleEvent( nEvent, mp1, mp2 )
         ENDIF
      ENDDO

Code: Alles auswählen

PROCEDURE FullView( cFile , nTimeout)
DEFAULT nTimeout TO 0

   nEvent := APPEVENT( @mp1, @mp2, @oXbp, nTimeout )
   DO CASE
      CASE nEvent == xbe_None
            EXIT
      CASE nEvent == xbeP_Keyboard .AND. mp1 == xbeK_ESC
            EXIT   
   OTHERWISE
      oXbp:HandleEvent( nEvent, mp1, mp2 )
   ENDCASE
   oDlg:destroy()