 |
FUNCTION BUILDBMP(nWidth, nHeight, nVids, nParam1, nParam2, nParam3) && @ by TAS (tascold@mail.ru) - 2006 г.
*--------------------------------------------------------------------------------------------
* возвращает BMP картинку
* nWidth - Ширина
* nHeight - Высота
* nVids - 1-горизонтальный,2-вертикальный градиент; 3-вертикальные,4-горизонтальные линии; 5-шахматка; 6-сетка;
* nParam1 - Основной цвет
* nParam2 - для 1,2 - % разности цвета для построения градиента; для остальных - дополнительный цвет (не обязательный параметер).
* nParam3 - для 3,4,5,6 - размер ячейки (не обязательный параметер)
*--------------------------------------------------------------------------------------------
* =STRTOFILE(BuildBMP(100,20,2,RGB(160,0,160),50),'knback.bmp')
*--------------------------------------------------------------------------------------------
* Одно замечание - данная функция для формирования небольших файлов, не рекомендуется создавать
* градиент для фона экрана 800х600 пикселей (вы его конечно получите, но после ненужной паузы в
* пару - тройку секунд) - лучше сделать 1х600 и растянуть!
*--------------------------------------------------------------------------------------------
LOCAL i, j, cBMP, cColArray
IF m.nWidth*m.nHeight<1
RETURN .F.
ENDIF
cBMP = 'BM' + NumToDWord(54 + m.nWidth * m.nHeight * 3) + NumToWord(0)+ NumToWord(0) + NumToDWord(54)
cBMP = cBMP + GetBMPInfoHeader(m.nWidth, m.nHeight)
cColArray = ''
LOCAL r_col,g_col,b_col,r_min,b_min,g_min,r_diff,b_diff,g_diff,red,blue,green
DO CASE
CASE INLIST(m.nVids,1,2) && 1-горизонтальный (2-вертикальный) градиент
b_col=floor(m.nParam1/65536) && (используется как фон для кнопки)
g_col=floor((m.nParam1-m.b_col*65536)/256)
r_col=floor(m.nParam1-m.b_col*65536-m.g_col*256)
nParam2=IIF(BETWEEN(m.nParam2,1,100),m.nParam2,100) && %
r_min=m.r_col-m.r_col*m.nParam2/100
b_min=m.b_col-m.b_col*m.nParam2/100
g_min=m.g_col-m.g_col*m.nParam2/100
r_diff=IIF(m.r_min+m.r_col*m.nParam2/50<=255,m.r_col*m.nParam2/50,255-m.r_min)
b_diff=IIF(m.b_min+m.b_col*m.nParam2/50<=255,m.b_col*m.nParam2/50,255-m.b_min)
g_diff=IIF(m.g_min+m.g_col*m.nParam2/50<=255,m.g_col*m.nParam2/50,255-m.g_min)
IF m.nVids=1
FOR j = m.nHeight-1 TO 0 STEP -1
FOR i = 0 TO m.nWidth-1
m.red=m.r_min+ROUND(m.r_diff*m.i/m.nWidth,0)
m.blue=m.b_min+ROUND(m.b_diff*m.i/m.nWidth,0)
m.green=m.g_min+ROUND(m.g_diff*m.i/m.nWidth,0)
cColArray=m.cColArray+GetBinaryColor(RGB(m.red,m.green,m.blue))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
ELSE
FOR j = m.nHeight-1 TO 0 STEP -1
m.red=m.r_min+m.r_diff-ROUND(m.r_diff*m.j/m.nHeight,0)
m.blue=m.b_min+m.b_diff-ROUND(m.b_diff*m.j/m.nHeight,0)
m.green=m.g_min+m.g_diff-ROUND(m.g_diff*m.j/m.nHeight,0)
FOR i = 0 TO m.nWidth-1
cColArray=m.cColArray+GetBinaryColor(RGB(m.red,m.green,m.blue))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
ENDIF
CASE INLIST(m.nVids,3,4) && Линии: 3 - вертикальные, 4 - горизонтальные
IF TYPE("nParam2")#"N"
nParam2=RGB(255,255,255) && по умолчанию второй цвет - белый
ENDIF
IF TYPE("nParam3")#"N"
nParam3=4 && по умолчанию размер ячейки
ENDIF
nParam3=IIF(BETWEEN(m.nParam3,1,1000),m.nParam3,5) && размер ячейки
IF m.nVids=3
FOR j = m.nHeight-1 TO 0 STEP -1
FOR i = 0 TO m.nWidth-1
cColArray=m.cColArray+GetBinaryColor(IIF(MOD(m.i,m.nParam3)>=m.nParam3/2,m.nParam1,m.nParam2))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
ELSE
FOR j = m.nHeight-1 TO 0 STEP -1
FOR i = 0 TO m.nWidth-1
cColArray=m.cColArray+GetBinaryColor(IIF(MOD(m.j,m.nParam3)>=m.nParam3/2,m.nParam1,m.nParam2))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
ENDIF
CASE INLIST(m.nVids,5) && Шахматная доска
IF TYPE("nParam2")#"N"
nParam2=RGB(255,255,255) && по умолчанию второй цвет - белый
ENDIF
IF TYPE("nParam3")#"N"
nParam3=4 && по умолчанию размер ячейки
ENDIF
nParam3=IIF(BETWEEN(m.nParam3,1,1000),m.nParam3,5) && размер ячейки
FOR j = m.nHeight-1 TO 0 STEP -1
FOR i = 0 TO m.nWidth-1
cColArray=m.cColArray+GetBinaryColor(IIF(MOD(m.i,m.nParam3)>=m.nParam3/2,IIF(MOD(m.j,m.nParam3)>=m.nParam3/2,m.nParam1,m.nParam2),IIF(MOD(m.j,m.nParam3)>=m.nParam3/2,m.nParam2,m.nParam1)))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
CASE INLIST(m.nVids,6) && Сетка
IF TYPE("nParam2")#"N"
nParam2=RGB(255,255,255) && по умолчанию второй цвет - белый
ENDIF
IF TYPE("nParam3")#"N"
nParam3=4 && по умолчанию размер ячейки
ENDIF
nParam3=IIF(BETWEEN(m.nParam3,2,1000),m.nParam3,5) && размер ячейки
FOR j = m.nHeight-1 TO 0 STEP -1
FOR i = 0 TO m.nWidth-1
cColArray=m.cColArray+GetBinaryColor(IIF(MOD(m.i,m.nParam3)=0 OR MOD(m.j,m.nParam3)=0,m.nParam1,m.nParam2))
ENDFOR
cColArray = m.cColArray + REPLICATE(CHR(0),MOD(m.nWidth,4)) && Width must be divisible by 4
ENDFOR
ENDCASE
cBMP = m.cBMP + m.cColArray
RETURN m.cBMP && возвращается готовая BMP картинка
*--------------------------------------------------------------------------------------------
FUNCTION GetBMPInfoHeader(tnWidth, tnHeight) && вызывается из BuildBMP
LOCAL cHeader, cZero
cZero = NumToDWord(0)
cHeader = NumToDWord(40) + NumToDWord(m.tnWidth) + NumToDWord(m.tnHeight)
cHeader = m.cHeader + NumToWord(1) + NumToWord(24) + m.cZero + m.cZero
cHeader = m.cHeader + NumToDWord(3780) + NumToDWord(3780) + m.cZero + m.cZero
RETURN m.cHeader
*--------------------------------------------------------------------------------------------
FUNCTION GetBinaryColor(tnColor) && вызывается из BuildBMP
RETURN SUBSTR(BINTOC(MAX(m.tnColor,0) - 2147483648),2)
*--------------------------------------------------------------------------------------------
FUNCTION NumToDWord(tnVal) && вызывается из BuildBMP
LOCAL cBin
cBin = BINTOC(m.tnVal - 2147483648)
RETURN SUBSTR(m.cBin,4,1) + SUBSTR(m.cBin,3,1) + SUBSTR(m.cBin,2,1) + SUBSTR(m.cBin,1,1)
*--------------------------------------------------------------------------------------------
FUNCTION NumToWord(tnVal) && вызывается из BuildBMP
LOCAL cBin
cBin = BINTOC(m.tnVal - 32768, 2)
RETURN SUBSTR(m.cBin,2,1) + SUBSTR(m.cBin,1,1)
|
|
Конференция
