Gradient as Dialog background

[rdonnay]

I received a request to show how to paint a gradient background in a window.

This uses the DCSTATIC .. OWNERDRAW feature.

Code: Select all

#INCLUDE "dcdialog.CH"
#INCLUDE "gra.CH"

FUNCTION Main()

LOCAL GetList[0], GetOptions, oStatic1, oStatic2, ;
      oGroup1, oGroup2, oGroup3, oGroupStatic2, aData[20], i, aColor1, aColor2, ;
      oBrowse, aDir := Directory()

aColor1 := { GraMakeRGBColor({244,248,250}), ;
             GraMakeRGBColor({170,200,220}) }

aColor2 := { GraMakeRGBColor({170,200,220}), ;
             GraMakeRGBColor({244,248,250}) }

AFill(aData,123.45)

@ 0, 0 DCSTATIC SIZE 800,600 TYPE XBPSTATIC_TYPE_TEXT ;
       OWNERDRAW {|oPS|PaintGradient(oStatic1,oPS,aColor1)} ;
       OBJECT oStatic1

@ 10,10 DCGROUP oGroup1 CAPTION 'Inventory Definition' ;
       SIZE 300,300 ;
       COLOR GRA_CLR_BLACK, { 220,220,220 } ;
       PARENT oStatic1 ;
       RESIZE DCGUI_RESIZE_REPOSONLY_Y

@ 10,340 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT ;
       SIZE 300,200 ;
       COLOR GRA_CLR_BLACK, GRA_CLR_PALEGRAY ;
       PARENT oStatic1 ;
       OBJECT oGroupStatic2 ;
       RESIZE DCGUI_RESIZE_REPOSONLY_Y

@ 0,0 DCGROUP oGroup2 ;
       CAPTION 'Raw Material' ;
       SIZE 300,200 ;
       PARENT oGroupStatic2 ;
       COLOR GRA_CLR_BLACK, GRA_CLR_PALEGRAY ;
       RESIZE DCGUI_RESIZE_REPOSONLY_Y

@ 320,10 DCGROUP oGroup3 CAPTION 'Supplier' ;
       SIZE 300,240 ;
       COLOR GRA_CLR_BLACK, { 220,220,220 } ;
       PARENT oStatic1 ;
       RESIZE DCGUI_RESIZE_REPOSONLY_Y

FOR i := 1 TO 13
  @ i*20,20 DCSAY 'This is ' + Alltrim(Str(i)) GET aData[i] ;
    PARENT oGroup1 SAYSIZE 100, 20 SAYRIGHTBOTTOM
NEXT

FOR i := 1 TO 8
  @ i*20,20 DCSAY 'This is ' + Alltrim(Str(i)) GET aData[i] ;
    PARENT oGroup2 SAYSIZE 100, 20 SAYRIGHTBOTTOM
NEXT

FOR i := 1 TO 10
  @ i*20,20 DCSAY 'This is ' + Alltrim(Str(i)) GET aData[i] ;
    PARENT oGroup3 SAYSIZE 100, 20 SAYRIGHTBOTTOM
NEXT

@ 250, 340 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT SIZE 400, 300 ;
       OWNERDRAW {|oPS|PaintGradient(oStatic2,oPS,aColor2)} ;
       OBJECT oStatic2 ;
       PARENT oStatic1

@ 30,30 DCBROWSE oBrowse DATA aDir SIZE 340,240 PARENT oStatic2 ;
        USEVISUALSTYLE

DCBROWSECOL ELEMENT 1 HEADER 'File Name' WIDTH 80 PARENT oBrowse
DCBROWSECOL ELEMENT 2 HEADER 'File Size' WIDTH 80 PARENT oBrowse
DCBROWSECOL ELEMENT 3 HEADER 'File Date' WIDTH 80 PARENT oBrowse
DCBROWSECOL ELEMENT 4 HEADER 'File Time' WIDTH 80 PARENT oBrowse

@ 570, 100 DCPUSHBUTTON CAPTION '&Add' SIZE 50,20 PARENT oStatic1 ;
     RESIZE DCGUI_RESIZE_NONE

@ DCGUI_ROW, DCGUI_COL + 10 DCPUSHBUTTON CAPTION '&Save' SIZE 50, 20 PARENT oStatic1 ;
     RESIZE DCGUI_RESIZE_NONE

@ DCGUI_ROW, DCGUI_COL + 10 DCPUSHBUTTON CAPTION 'Cancel' SIZE 60, 20 PARENT oStatic1 ;
     RESIZE DCGUI_RESIZE_NONE

DCGETOPTIONS ;
   PIXEL ;
   RESIZE RESIZEDEFAULT DCGUI_RESIZE_RESIZEONLY ;
   FITPAD 0

DCREAD GUI FIT TITLE 'Gradient Test' OPTIONS GetOptions

RETURN nil

* ----------

PROC appsys ; RETURN

* ----------

STATIC FUNCTION PaintGradient( oStatic, oPS, aColor )

GraGradient( oPS, {0,0}, {oStatic:currentSize()}, aColor, GRA_GRADIENT_VERTICAL )

RETURN oStatic

gradient.jpg (95.11 KiB) Viewed 4893 times

[Eugene Lutsenko]

Handsomely! I'll use it. Thank you! The Eidos system have something like this (attached file). I use it for the background of the main window. But now it will be for dialogs.

Code: Select all

*********************************************************************************************************
******** Организация смены фона главного окна
*********************************************************************************************************
FUNCTION GradFonStart(Par)

PUBLIC oTimer, oDlgBmp              // Градиентные фоны главного окна

aBitmaps := Directory(Disk_dir+'\Aid_data\BackGround\*.jpg')

*HH = VAL(SUBSTR(TIME(),1,2))            // Часы
*MM = VAL(SUBSTR(TIME(),4,2))            // Минуты
*SS = VAL(SUBSTR(TIME(),7,2))            // Секунды

*mTime = HH*3600 + MM*60 + SS            // Время, прошедшее с начала суток в секундах
*D = 86400 / LEN( aBitmaps )             // Величина интервала имен фонов с одинаковым индексом
*snPointer = 1 + INT( (mTime-1) / D )    // Индекс отображаемого фона

  DCGETOPTIONS ;
       WINDOWHEIGHT H_MainWind ;
       WINDOWWIDTH  W_MainWind

*FullView( (Disk_dir+'\Aid_data\BackGround\'+aBitmaps[snPointer,1]) )

 IF .NOT. FILE('_CheckSum.arx')
    DeleleGradFon()
 ENDIF

 IF LEN(aBitmaps) = 0
    ERASE('_CheckSum.arx')
 ENDIF

* IF LEN(aBitmaps) > 0 .AND. FILE('_CheckSum.arx')
    oTimer := DC_SetTimerEvent():new(1000,{||ChangeBackground(@oDlgBmp, Par)})   // Смена фона через время, зависящее от числа фонов. Ед.изм. 0.01 секунды
* ENDIF

*DCREAD GUI TITLE 'Смена фона каждую секунду, минуту, час' PARENT @oDlgBmp OPTIONS GetOptions

RETURN nil

[/size]

Code: Select all

FUNCTION ChangeBackground( oDlgBmp, Par )

LOCAL oBitmap

STATIC snPointer := 0

aBitmaps := Directory(Disk_dir+'\Aid_data\BackGround\*.jpg')

*MsgBox(TIME())

HH = VAL(SUBSTR(TIME(),1,2))            // Часы
MM = VAL(SUBSTR(TIME(),4,2))            // Минуты
SS = VAL(SUBSTR(TIME(),7,2))            // Секунды

mTime = HH*3600 + MM*60 + SS            // Время, прошедшее с начала суток в секундах
D = 86400 / LEN( aBitmaps )             // Величина интервала имен фонов с одинаковым индексом
snPointer = 1 + INT( (mTime-1) / D )    // Индекс отображаемого фона

*MsgBox(STR(snPointer)+STR(LEN(aBitmaps)))

IF snPointer = 0 .OR. snPointer > LEN(aBitmaps)
  snPointer := 1
ENDIF

   *** Проверять демонстрируемое изображение фона на совпадение контрольной суммы, 
   *** чтобы его невозможно было заменить использовать массив контрольных сумм.
   *** Массив контрольных сумм формировать и записывать после формирования и записи фонов.

   IF FILE("_CheckSum.arx") .AND. LEN(aBitmaps) > 0

      aCheckSum = DC_ARestore("_CheckSum.arx")
*     DC_ASave(aCheckSum, "_CheckSum.arx")

      IF LEN(aBitmaps) = LEN(aCheckSum)
         IF snPointer <= LEN(aCheckSum)
            IF aCheckSum[snPointer] = FILECHECK(Disk_dir+'\Aid_data\BackGround\'+aBitmaps[snPointer,1])

               oBitmap := DC_GetBitmap(Disk_dir+'\Aid_data\BackGround\'+aBitmaps[snPointer,1])

               IF Par = 1
                  MILLISEC(5000)
               ENDIF

               *** Это все Роджер

*              oDlgBmp:lockUpdate(.t.)
*              oDlgBmp:drawingArea:bitmap := oBitmap
*              oDlgBmp:configure()
*              oDlgBmp:lockUpdate(.f.)

               oDlgBmp:drawingArea:bitmap := oBitmap
               oDlgBmp:drawingArea:sizeRedraw := .t.
               oDlgBmp:drawingArea:setSize(oDlgBmp:drawingArea:currentSize())
               oDlgBmp:drawingArea:configure()
               oDlgBmp:invalidateRect()

            ENDIF
         ENDIF
      ENDIF
   ENDIF

RETURN nil

[/size]