[DiS[IP]]

И так вот второй вариант цветного шрифта сам тестил мне понравился
Особенности:
1. Возможность смены как самого шрифта так и его цвета во время выполнения мидлета.
2. Быстрота Инициализации около 1 сек. на Moto с380
3. Поддержка перехода на новую строку
4. Возможность отображения выделенного текста другим цветом (при отключении время инициализации уменьшается в двое!)
Минусы:
1. Максимальный размер 1 буквы равен (Ширина экрана / 16) высота равна Высоте экрана
2. Воспренимает только формат шрифта созданного конвертором (см. 1 сообщение)

Если кому нужен способ создания файла со шрифтом я опишу!

unit font;

interface
var 
	fnt: array[32..258] of image;
	caret: array[32..258] of image;
 new_y: integer;
	res: resource;
	
// Требуется передать fnm - имя файла со шрифтом, fWidth, fHeight - высота ширина буквы,
// sR, sG, sB - цвет букв, fR, fG, fB - цвет фона (прозрачный фон как сделать пока не понял) 
	
procedure FontInit(fnm:string; fWidth, fHeight, sr, sg, sb, fr, fg, fb : integer);

// Требуется передать текст и координаты прямоугольника для вывода текста
// (Подерживается символ #13 - переход на новую строку)

function OutLongStr(str: string; x,y,x1, y1:integer):integer;
function OutLongCaret(str: string; x,y,x1, y1:integer):integer;

implementation

//---------------------------------------------------//

procedure FontInit(fnm:string; fWidth, fHeight, sr, sg, sb, fr, fg, fb : integer);
var 
 x, y, k : integer;
 bx: char;
 
begin
	x := 0;
	y := 1;
	k := 0; 	
	bx := '1';
	
	res := OpenResource('/' + fnm);

	setcolor(fr, fg, fb);
	fillrect(0, 0, 128, fHeight+1);
	setcolor(sr, sg, sb);
  
	while ord(bx) <> 0 do 
 begin
  bx := Chr(ReadByte(res));
  
  if (ord(bx) = -1) then
   begin  
  	x := 0;
  	y := y + 1;   
    if (y - 1 = fHeight) then 
   begin
   
  	for x:= 0 to 15 do
     fnt[32 + k * 16 + x] := ImageFromCanvas(x*6+1, 1, fWidth, fHeight);   
     
  	setcolor(fr, fg, fb);
  	fillrect(0, 0, 128, fHeight+1);
  	setcolor(sr, sg, sb);
  	
  	y := 1;
  	x := 0;
  	k := k + 1;
    end;
   end
  else
   begin
   
    x := x + ord(bx);
    Plot(x, y);
   end;
	end; 
 
	CloseResource(res);
	setcolor(fr, fg, fb);
 fillrect(0, 0, GetWidth, GetHeight);
 setcolor(sr, sg, sb);
 
 //--------------------------------------------------//
	x := 0;
	y := 1;
	k := 0; 	
	bx := '1';
	
	res := OpenResource('/' + fnm);
	
	setcolor(sr, sg, sb);
	fillrect(0, 0, 128, fHeight+1);
	setcolor(fr, fg, fb);
  
	while ord(bx) <> 0 do 
 begin
  bx := Chr(ReadByte(res));
  
  if (ord(bx) = -1) then
   begin  
  	x := 0;
  	y := y + 1;   
    if (y - 1 = fHeight) then 
   begin
   
  	for x:= 0 to 15 do
     caret[32 + k * 16 + x] := ImageFromCanvas(x*6+1, 1, fWidth, fHeight); 
  
  	setcolor(sr, sg, sb);     
  	fillrect(0, 0, 128, fHeight+1);
  	setcolor(fr, fg, fb);
  	
  	y := 1;
  	x := 0;
  	k := k + 1;
    end;
   end
  else
   begin
   
    x := x + ord(bx);
    Plot(x, y);
   end;
	end;
 
 setcolor(sr, sg, sb); 
	CloseResource(res);
	fillrect(0, 0, GetWidth, GetHeight);
 setcolor(fr, fg, fb);

end;

//---------------------------------------------------//
 // Функция вывода текста в заданный регион 
 // Внимание! Обновления экрана производить самим!

function OutLongStr(str: string; x,y,x1, y1:integer):integer;
var i,a,b, fx, fy : integer;
begin
 fx:= x; fy:=y;
	b:=0;
	OutLongStr:= -1;
	for i:= 0 to Length(str) - 1 do begin
  a:= Ord(GetChar(str, i));
  if a > 255 then a:= a - 848;
  fx:= x + b * GetImageWidth(fnt[32]);
  if a = 13 then begin 
   fy := fy + GetImageHeight(fnt[32]);
   fx:= x; b:=0;
  end;
  if (fx > x1 - 4) then begin
   fy:= fy + GetImageHeight(fnt[32]);
   fx:= x; b:=0;
  end;
  if fy > y1 then begin
   OutLongStr:= i;
   break;
  end; 
  if a <> 13 then begin
   DrawImage(fnt[a], fx, fy);b:=b+1;
  end;
	end;
	new_y:= fy+GetImageHeight(fnt[32]);
end;

//---------------------------------------------------//
  // Печатает текст с перевернутыми цветами
  // пригодится для выделения фрагмента текста

function OutLongCaret(str: string; x,y,x1, y1:integer):integer;
var i,a,b, fx, fy : integer;
begin
 fx:= x; fy:=y;
	b:=0;
	OutLongCaret:= -1;
	for i:= 0 to Length(str) - 1 do begin
  a:= Ord(GetChar(str, i));
  if a > 255 then a:= a - 848;
  if a = 13 then begin 
   fy := fy + GetImageHeight(caret[32]);
   fx:= x; b:=0;
  end;
  fx:= x + b * GetImageWidth(caret[32]);
  if (fx > x1 - 4) then begin
   fy:= fy + GetImageHeight(caret[32]);
   fx:= x; b:=0;
  end;
  if fy > y1 then begin
   OutLongCaret:= i;
   break;
  end;
  if a <> 13 then begin 
   DrawImage(caret[a], fx, fy);b:=b+1;
  end;
	end;
	new_y:= fy+GetImageHeight(caret[32]);
end;

//---------------------------------------------------//

initialization
	//FontInit('font.txt', 6, 9, 0, 255, 0, 0, 0, 0);
end.