Функция для генерации BMP файла с фоновым рисунком, задаваемым через параметры.

Рисует 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

Автор публикации

не в сети 20 лет

TAS

0
Комментарии: 0Публикации: 7Регистрация: 28-09-2000
0
Оставить комментарий
Авторизация
*
*
Регистрация
*
*
*
Пароль не введен
*
Генерация пароля