Рисует 6 типов фона: 1-горизонтальный градиент; 2-вертикальный градиент; 3-вертикальные линии; 4-горизонтальные линии; 5-шахматка; 6-сетка. (Выкладывалась ранее на форуме, решил и сюда добавить.)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)
Автор: TAS
Автор публикации
Комментарии: 0Публикации: 7Регистрация: 28-09-2000