Страница 1 из 1

Может кому пригодится

Добавлено: 15 июл 2009, 20:05
galover
Запостить в опыт не могу, пишу сюда, может кому пригодится. Накидал интерфейс для подбора цвета шрифтов и фона (открытие через "Запуск внешнего интерфейса")
Внешний вид:
Изображение
Код:

Код: Выделить всё

#component "Utils"

interface ColorDetect 'Подборка цвета', dialog;
	show at (,, 60, 20);
	
	table struct local tblTest
	(
		NRec : comp,
		Name : string
	);
	
	create view from tblTest;
	
	var
		_fontColor  : word;
		_backColor  : word;
		_fontParams : word;		
		_isItalic   : boolean;
		_isBold     : boolean;
		
		_strTest    : string;
			
	screen scrMain;
		show at(,,, 5);
		noTableNavigation;
		
		fields			
			_fontColor  : [3], noprotect;			
			_fontParams : noprotect;
			_backColor  : [3], noprotect;			
		buttons
			cmApply;
<<
  `Цвет шрифта:`.@@    [.] Italic`
  `Цвет фона:`  .@@    [.] Bold`  
	
	<. Применить .>
>>
	end;
	
	screen scrTest;
		show at(, 6,, 7)
		noTableNavigation;
		
		fields			 			
			_strTest : protect, skip, { font = { bold = _isBold; italic = _isItalic; color = _fontColor; backColor = _backColor; } };
			_strTest : protect, skip, { font = { bold = _isBold; italic = _isItalic; color = _fontColor; } };
<<
  .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
  .@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
>>
	end;

	#define CheckOrder(trueCon, falseCon) If(Longint(tblTest.NRec) mod 2 = 0, #trueCon, #falseCon)
	
	browse brwsTest;
		show at(, 8,,);
		table tblTest;
		
		fields			
			{ font = {
								bold      = #CheckOrder(_isBold, false);
								italic    = #CheckOrder(_isItalic, false);
								color     = #CheckOrder(_fontColor, ColorSysBlack);
								backColor = #CheckOrder(_backColor, 0); 
							 }
			};
			tblTest.NRec  #3'Идентификатор' : [20], noAutoSize, protect;
			tblTest.Name  #3'Наименование'  : [20], noAutoSize, protect;
	end;
	
	private procedure ApplyChanges;
	{
		_isItalic := (_fontParams and 1) = 1;
		_isBold   := (_fontParams and 2) = 2;
		
		ReScanPanel(#tblTest);
	}
	
	handleEvent	
		cmInit:
		{
			_strTest := 'Cъешь ещё этих мягких французских булок, да выпей чаю';
			
			var i : longint;
			
			for (i := 0; i < 1000; i++)
				insert into tblTest set tblTest.NRec := i, tblTest.Name := 'Наименование ' + String(i);
		}
		cmApply:
		{
			ApplyChanges();
		}	
		cmCheckField:
		{
			ApplyChanges();
		}
	end;
end.

Добавлено: 15 июл 2009, 22:06
Masygreen
Не знаю пригодится ли .. но спасибо :) деление опытом это гуд :)

Добавлено: 16 июл 2009, 22:35
Ged
На самом деле в опыт.
Для неофитов да и просто чтоб было под рукой.
+5

Добавлено: 17 июл 2009, 08:54
Darikon
+5

Добавлено: 17 июл 2009, 10:48
m0p3e
Хм. Года 3 назад писал для себя тоже самое. Не думал, что такой спрос... :)