FoxPro Club Главная

Конференция Решения Фотоальбом Сайт М.Дроздова Статьи Файловый архив Книга Visual FoxPro 9.0 Русский Help для Visual FoxPro
Пользователей: 9239
Вход
Функция для генерации BMP файла с фоновым рисунком, задаваемым через параметры.

Рисует 6 типов фона: 1-горизонтальный градиент; 2-вертикальный градиент; 3-вертикальные линии; 4-горизонтальные линии; 5-шахматка; 6-сетка. (Выкладывалась ранее на форуме, решил и сюда добавить.)


 
Прислал: TAS   Категория: Графика


  
  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)    
  

 
Сделайте оценку этого решения Плохо Удовлетворительно Так себе Хорошо Отлично Текущая оценка: (2.333)
Дополнения пользователей
Функция для генерации BMP файла с фоновым рисунком, задаваемым через параметры.
[+][?]
[Дополнить]



© 2000-2017 Fox Club 
При размещении любых материалов с сайта на других ресурсах- прямая ссылка на www.foxclub.ru обязательна
Яндекс.Метрика