Показать сообщение отдельно
Старый 05.03.2006, 21:38   #1
DiS[IP]
AnyKey`щик
 
Регистрация: 04.03.2006
Сообщений: 18
Написано 0 полезных сообщений
(для 0 пользователей)
У меня тут интересная идея насчет своих шрифтов. Я тут поразбирался и набросал функции для шрифтов, Которым можно менять цвет. Чтобы создать такой шрифт я прогнал картинку со шрифтом через свою программу она создает из него некий бинарник каждый байт в котором указывает на следующую точку шрифта. Файл получился весьма небольшой (При шрифте 6x9 2.5 kb). Но есть ограничения длина символа не может быть более 15 пикселей . Вот font.mpsrc
 unit font;

interface
var 
	fnt: array[32..258] of image;
 new_y: integer;
	res: resource;
	
procedure FontInit(fnm:string; fWidth, fHeight, sr, sg, sb, fr, fg, fb : integer);
function OutLongStr(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 : integer;
 bx: char;
 
begin
	x := 0;
	y := 0; 	
	bx := '1';
	
	res := OpenResource('/' + fnm);

	setcolor(fr, fg, fb);
	fillrect(0, 0, GetWidth, GetHeight);
	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;
   end
  else
   begin
   x := x + ord(bx);
    Plot(x, y);
   end;
 end; 
	CloseResource(res);
 for y:= 0 to 13 do 
 for x:= 0 to 15 do
 	fnt[y * 16 + x + 32]:= ImageFromCanvas(x*fwidth+1, y*fheight, fwidth, fheight);
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 (fx > x1 - 4) then begin
   fy:= fy + GetImageHeight(fnt[32]);
   fx:= x; b:=0;
  end;
  if fy > y1 then begin
   OutLongStr:= i;
   break;
  end; 
  DrawImage(fnt[a], fx, fy);b:=b+1;
	end;
	new_y:= fy+GetImageHeight(fnt[32]);
end;

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

initialization
	FontInit('font.txt', 6, 9, 0, 255, 0, 0, 0, 0);
end.
В комплекте шрифт 6x9 [attachmentid=805] и программа [attachmentid=804] для конвертации bmp => шрифт и просмотра.
Кто будет тейстить пусть отпишется сдесь
(Offline)
 
Ответить с цитированием