gtext.inc 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {***************************************************************************}
  12. { Text output routines }
  13. {***************************************************************************}
  14. const
  15. maxfonts = 16; { maximum possible fonts }
  16. MaxChars = 255; { Maximum nr. of characters in a file }
  17. Prefix_Size = $80; { prefix size to skip }
  18. SIGNATURE = '+'; { Signature of CHR file }
  19. type
  20. (* pbyte = ^byte;
  21. pword = ^word;
  22. *)
  23. { Prefix header of Font file }
  24. { PFHeader = ^TFHeader;}
  25. TFHeader = packed record
  26. header_size: word; {* Version 2.0 Header Format *}
  27. font_name: array[1..4] of char;
  28. font_size: word; {* Size in byte of file *}
  29. font_major: byte; {* Driver Version Information *}
  30. font_minor: byte;
  31. min_major: byte; {* BGI Revision Information *}
  32. min_minor: byte;
  33. end;
  34. { Font record information }
  35. { PHeader = ^THeader;}
  36. THeader = packed record
  37. Signature: char; { signature byte }
  38. Nr_chars: smallint; { number of characters in file }
  39. Reserved: byte;
  40. First_char: byte; { first character in file }
  41. cdefs : smallint; { offset to character definitions }
  42. scan_flag: byte; { TRUE if char is scanable }
  43. org_to_cap: shortint; { Height from origin to top of capitol }
  44. org_to_base:shortint; { Height from origin to baseline }
  45. org_to_dec: shortint; { Height from origin to bot of decender }
  46. _reserved: array[1..4] of char;
  47. Unused: byte;
  48. end;
  49. TOffsetTable =array[0..MaxChars] of smallint;
  50. TWidthTable =array[0..MaxChars] of byte;
  51. tfontrec = packed record
  52. name : string[8];
  53. header : THeader; { font header }
  54. pheader : TFHeader; { prefix header }
  55. offsets : TOffsetTable;
  56. widths : TWidthTable;
  57. instrlength: longint; { length of instr, because instr can }
  58. instr : pchar; { contain null characters }
  59. end;
  60. { pStroke = ^TStroke;}
  61. TStroke = packed record
  62. opcode: byte;
  63. x: smallint; { relative x offset character }
  64. y: smallint; { relative y offset character }
  65. end;
  66. TStrokes = Array[0..1000] of TStroke;
  67. opcodes = (_END_OF_CHAR, _DO_SCAN, _MOVE, _DRAW);
  68. var
  69. fonts : array[1..maxfonts] of tfontrec;
  70. Strokes: TStrokes; {* Stroke Data Base *}
  71. { Stroke_count: Array[0..MaxChars] of smallint;} {* Stroke Count Table *}
  72. {***************************************************************************}
  73. { Internal support routines }
  74. {***************************************************************************}
  75. function ConvertString(const OrigString: String): String;
  76. var
  77. i: Integer;
  78. ConvResult: String;
  79. begin
  80. if GraphStringTransTable = nil then
  81. ConvertString := OrigString
  82. else
  83. begin
  84. SetLength(ConvResult, Length(OrigString));
  85. for i := 1 to Length(OrigString) do
  86. ConvResult[i] := GraphStringTransTable^[OrigString[i]];
  87. ConvertString := ConvResult;
  88. end;
  89. end;
  90. function testfont(p : pchar) : boolean;
  91. begin
  92. testfont:=(p[0]='P') and
  93. (p[1]='K') and
  94. (p[2]=#8) and
  95. (p[3]=#8);
  96. end;
  97. function InstallUserFont(const FontFileName : string) : smallint;
  98. begin
  99. _graphresult:=grOk;
  100. { first check if we do not allocate too many fonts! }
  101. if installedfonts=maxfonts then
  102. begin
  103. _graphresult:=grError;
  104. InstallUserFont := DefaultFont;
  105. exit;
  106. end;
  107. inc(installedfonts);
  108. fonts[installedfonts].name:=FontFileName;
  109. fonts[installedfonts].instr := nil;
  110. fonts[installedfonts].instrlength := 0;
  111. InstallUserFont:=installedfonts;
  112. end;
  113. function Decode(byte1,byte2: char; var x,y: smallint): smallint;
  114. { This routines decoes a signle word in a font opcode section }
  115. { to a stroke record. }
  116. var
  117. b1,b2: shortint;
  118. Begin
  119. b1:=shortint(byte1);
  120. b2:=shortint(byte2);
  121. { Decode the CHR OPCODE }
  122. Decode:=smallint(((b1 and $80) shr 6)+((b2 and $80) shr 7));
  123. { Now get the X,Y coordinates }
  124. { bit 0..7 only which are considered }
  125. { signed values. }
  126. {$R-}
  127. b1:=b1 and $7f;
  128. b2:=b2 and $7f;
  129. { Now if the MSB of these values are set }
  130. { then the value is signed, therefore we }
  131. { sign extend it... }
  132. if (b1 and $40)<>0 then b1:=b1 or $80;
  133. if (b2 and $40)<>0 then b2:=b2 or $80;
  134. x:=smallint(b1);
  135. y:=smallint(b2);
  136. {$ifdef debug}
  137. {$R+}
  138. {$endif debug}
  139. end;
  140. function unpack(buf: pchar; index: smallint; var Stroke: TStrokes): smallint;
  141. var
  142. po: TStrokes;
  143. num_ops: smallint;
  144. opcode, i, opc: word;
  145. counter: smallint;
  146. lindex: smallint;
  147. jx, jy: smallint;
  148. begin
  149. num_ops := 0;
  150. counter := index;
  151. lindex :=0;
  152. while TRUE do {* For each byte in buffer *}
  153. Begin
  154. Inc(num_ops); {* Count the operation *}
  155. opcode := decode( buf[counter], buf[counter+1] ,jx, jy );
  156. Inc(counter,2);
  157. if( opcode = ord(_END_OF_CHAR) ) then break; {* Exit loop at end of char *}
  158. end;
  159. counter:=index;
  160. for i:=0 to num_ops-1 do { /* For each opcode in buffer */ }
  161. Begin
  162. opc := decode(buf[counter], buf[counter+1], po[lindex].x, po[lindex].y); {* Decode the data field *}
  163. inc(counter,2);
  164. po[lindex].opcode := opc; {* Save the opcode *}
  165. Inc(lindex);
  166. end;
  167. Stroke:=po;
  168. unpack := num_ops; {* return OPS count *}
  169. end;
  170. procedure GetTextPosition(var xpos,ypos: longint; const TextString: string);
  171. begin
  172. if CurrentTextInfo.Font = DefaultFont then
  173. begin
  174. if Currenttextinfo.direction=horizdir then
  175. begin
  176. case Currenttextinfo.horiz of
  177. centertext : XPos:=(textwidth(textstring) shr 1);
  178. lefttext : XPos:=0;
  179. righttext : XPos:=textwidth(textstring);
  180. end;
  181. case Currenttextinfo.vert of
  182. centertext : YPos:=-(textheight(textstring) shr 1);
  183. bottomtext : YPos:=-textheight(textstring);
  184. toptext : YPos:=0;
  185. end;
  186. end else
  187. begin
  188. case Currenttextinfo.horiz of
  189. centertext : XPos:=(textheight(textstring) shr 1);
  190. lefttext : XPos:=textheight(textstring);
  191. righttext : XPos:=textheight(textstring);
  192. end;
  193. case Currenttextinfo.vert of
  194. centertext : YPos:=(textwidth(textstring) shr 1);
  195. bottomtext : YPos:=0;
  196. toptext : YPos:=textwidth(textstring);
  197. end;
  198. end;
  199. end
  200. else
  201. begin
  202. if Currenttextinfo.direction=horizdir then
  203. begin
  204. case CurrentTextInfo.horiz of
  205. centertext : XPos:=(textwidth(textstring) shr 1);
  206. lefttext : XPos:=0;
  207. righttext : XPos:=textwidth(textstring);
  208. end;
  209. case CurrentTextInfo.vert of
  210. centertext : YPos:=(textheight(textstring) shr 1);
  211. bottomtext : YPos:=0;
  212. toptext : YPos:=textheight(textstring);
  213. end;
  214. end else
  215. begin
  216. case CurrentTextInfo.horiz of
  217. centertext : XPos:=(textheight(textstring) shr 1);
  218. lefttext : XPos:=0;
  219. righttext : XPos:=textheight(textstring);
  220. end;
  221. case CurrentTextInfo.vert of
  222. centertext : YPos:=(textwidth(textstring) shr 1);
  223. bottomtext : YPos:=0;
  224. toptext : YPos:=textwidth(textstring);
  225. end;
  226. end;
  227. end;
  228. end;
  229. {***************************************************************************}
  230. { Exported routines }
  231. {***************************************************************************}
  232. function RegisterBGIfont(font : pointer) : smallint;
  233. var
  234. hp : pchar;
  235. b : word;
  236. i: longint;
  237. Header: THeader;
  238. counter: longint;
  239. FontData: pchar;
  240. FHeader: TFHeader;
  241. begin
  242. RegisterBGIfont:=grInvalidFontNum;
  243. i:=0;
  244. { Check if the font header is valid first of all }
  245. if testfont(font) then
  246. begin
  247. hp:=pchar(font);
  248. { Move to EOF in prefix header }
  249. while (hp[i] <> chr($1a)) do Inc(i);
  250. move(hp[i+1],FHeader,sizeof(FHeader));
  251. move(hp[Prefix_Size],header,sizeof(Header));
  252. { check if the font name is already allocated? }
  253. i:=Prefix_Size+sizeof(Header);
  254. for b:=1 to installedfonts do
  255. begin
  256. if fonts[b].name=FHeader.Font_name then
  257. begin
  258. move(FHeader,fonts[b].PHeader,sizeof(FHeader));
  259. move(Header,fonts[b].Header,sizeof(Header));
  260. move(hp[i],Fonts[b].Offsets[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(smallint));
  261. Inc(i,Fonts[b].Header.Nr_chars*sizeof(smallint));
  262. move(hp[i],Fonts[b].Widths[Fonts[b].Header.First_Char],Fonts[b].Header.Nr_chars*sizeof(byte));
  263. Inc(i,Fonts[b].Header.Nr_chars*sizeof(byte));
  264. counter:=Fonts[b].PHeader.font_size+PREFIX_SIZE-i;
  265. { allocate also space for null }
  266. GetMem(FontData,Counter+1);
  267. move(hp[i],FontData^,Counter);
  268. { Null terminate the string }
  269. FontData[counter+1] := #0;
  270. if fonts[b].header.Signature<> SIGNATURE then
  271. begin
  272. _graphResult:=grInvalidFont;
  273. Freemem(FontData, Counter+1);
  274. exit;
  275. end;
  276. fonts[b].instr:=FontData;
  277. fonts[b].instrlength:=Counter+1;
  278. RegisterBGIfont:=b;
  279. end;
  280. end;
  281. end
  282. else
  283. RegisterBGIFont:=grInvalidFont;
  284. end;
  285. procedure GetTextSettings(var TextInfo : TextSettingsType);
  286. begin
  287. textinfo:=currenttextinfo;
  288. end;
  289. function TextHeight(const TextString : string) : word;
  290. begin
  291. if Currenttextinfo.font=DefaultFont
  292. then TextHeight:=8*CurrentTextInfo.CharSize
  293. else
  294. TextHeight:=Trunc((fonts[Currenttextinfo.font].header.org_to_cap-
  295. fonts[Currenttextinfo.font].header.org_to_dec) * CurrentYRatio);
  296. end;
  297. function TextWidth(const TextString : string) : word;
  298. var i,x : smallint;
  299. c : byte;
  300. s : String;
  301. begin
  302. x := 0;
  303. { if this is the default font ... }
  304. if Currenttextinfo.font = Defaultfont then
  305. TextWidth:=length(TextString)*8*CurrentTextInfo.CharSize
  306. { This is a stroked font ... }
  307. else begin
  308. s := ConvertString(TextString);
  309. for i:=1 to length(s) do
  310. begin
  311. c:=byte(s[i]);
  312. { dec(c,fonts[Currenttextinfo.font].header.first_char);}
  313. if (c-fonts[Currenttextinfo.font].header.first_char>=
  314. fonts[Currenttextinfo.font].header.nr_chars) then
  315. continue;
  316. x:=x+byte(fonts[Currenttextinfo.font].widths[c]);
  317. end;
  318. TextWidth:=round(x * CurrentXRatio) ;
  319. end;
  320. end;
  321. procedure OutTextXYDefault(x,y : smallint;const TextString : string);
  322. type
  323. Tpoint = record
  324. X,Y: smallint;
  325. end;
  326. var
  327. ConvString : String;
  328. i,j,k,c : longint;
  329. xpos,ypos : longint;
  330. counter : longint;
  331. cnt1,cnt2 : smallint;
  332. cnt3,cnt4 : smallint;
  333. charsize : word;
  334. WriteMode : word;
  335. curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
  336. oldvalues : linesettingstype;
  337. fontbitmap : TBitmapChar;
  338. chr : char;
  339. curx2i,cury2i,
  340. xpos2i,ypos2i : longint;
  341. begin
  342. { save current write mode }
  343. WriteMode := CurrentWriteMode;
  344. CurrentWriteMode := NormalPut;
  345. GetTextPosition(xpos,ypos,textstring);
  346. X:=X-XPos; Y:=Y+YPos;
  347. XPos:=X; YPos:=Y;
  348. ConvString := ConvertString(TextString);
  349. CharSize := CurrentTextInfo.Charsize;
  350. if Currenttextinfo.font=DefaultFont then
  351. begin
  352. c:=length(ConvString);
  353. if CurrentTextInfo.direction=HorizDir then
  354. { Horizontal direction }
  355. begin
  356. for i:=0 to c-1 do
  357. begin
  358. xpos:=x+(i*8)*Charsize;
  359. { we copy the character bitmap before accessing it }
  360. { this improves speed on non optimizing compilers }
  361. { since it is one less address calculation. }
  362. Fontbitmap:=TBitmapChar(DefaultFontData[ConvString[i+1]]);
  363. { no scaling }
  364. if CharSize = 1 then
  365. Begin
  366. for j:=0 to 7 do
  367. for k:=0 to 7 do
  368. if Fontbitmap[j,k]<>0 then
  369. PutPixel(xpos+k,j+y,CurrentColor)
  370. else if DrawTextBackground then
  371. PutPixel(xpos+k,j+y,CurrentBkColor);
  372. end
  373. else
  374. { perform scaling of bitmap font }
  375. Begin
  376. j:=0;
  377. cnt3:=0;
  378. while j <= 7 do
  379. begin
  380. { X-axis scaling }
  381. for cnt4 := 0 to charsize-1 do
  382. begin
  383. k:=0;
  384. cnt2 := 0;
  385. while k <= 7 do
  386. begin
  387. for cnt1 := 0 to charsize-1 do
  388. begin
  389. If FontBitmap[j,k] <> 0 then
  390. PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentColor)
  391. else if DrawTextBackground then
  392. PutPixel(xpos+cnt1+cnt2,y+cnt3+cnt4,CurrentBkColor);
  393. end;
  394. Inc(k);
  395. Inc(cnt2,charsize);
  396. end;
  397. end;
  398. Inc(j);
  399. Inc(cnt3,charsize);
  400. end;
  401. end;
  402. end;
  403. end
  404. else
  405. { Vertical direction }
  406. begin
  407. for i:=0 to c-1 do
  408. begin
  409. chr := ConvString[i+1];
  410. Fontbitmap:=TBitmapChar(DefaultFontData[chr]);
  411. ypos := y-(i shl 3)*CharSize;
  412. { no scaling }
  413. if CharSize = 1 then
  414. Begin
  415. for j:=0 to 7 do
  416. for k:=0 to 7 do
  417. if Fontbitmap[j,k] <> 0 then
  418. PutPixel(xpos+j,ypos-k,CurrentColor)
  419. else if DrawTextBackground then
  420. PutPixel(xpos+j,ypos-k,CurrentBkColor);
  421. end
  422. else
  423. { perform scaling of bitmap font }
  424. Begin
  425. j:=0;
  426. cnt3:=0;
  427. while j<=7 do
  428. begin
  429. { X-axis scaling }
  430. for cnt4 := 0 to charsize-1 do
  431. begin
  432. k:=0;
  433. cnt2 := 0;
  434. while k<=7 do
  435. begin
  436. for cnt1 := 0 to charsize-1 do
  437. begin
  438. If FontBitmap[j,k] <> 0 then
  439. PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,CurrentColor)
  440. else if DrawTextBackground then
  441. PutPixel(xpos+cnt3-cnt4,ypos+cnt1-cnt2,CurrentBkColor);
  442. end;
  443. Inc(k);
  444. Inc(cnt2,charsize);
  445. end;
  446. end;
  447. Inc(j);
  448. Inc(cnt3,charsize);
  449. end;
  450. end;
  451. end;
  452. end;
  453. end else
  454. { This is a stroked font which is already loaded into memory }
  455. begin
  456. getlinesettings(oldvalues);
  457. { reset line style to defaults }
  458. setlinestyle(solidln,oldvalues.pattern,normwidth);
  459. if Currenttextinfo.direction=vertdir then
  460. xpos:=xpos + Textheight(ConvString);
  461. CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
  462. CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
  463. { x:=xpos; y:=ypos;}
  464. for i:=1 to length(ConvString) do
  465. begin
  466. c:=byte(ConvString[i]);
  467. { Stroke_Count[c] := }
  468. unpack( fonts[CurrentTextInfo.font].instr,
  469. fonts[CurrentTextInfo.font].Offsets[c], Strokes );
  470. counter:=0;
  471. while true do
  472. begin
  473. if CurrentTextInfo.direction=VertDir then
  474. begin
  475. xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
  476. ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
  477. end
  478. else
  479. begin
  480. xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
  481. ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
  482. end;
  483. case opcodes(Strokes[counter].opcode) of
  484. _END_OF_CHAR: break;
  485. _DO_SCAN: begin
  486. { Currently unsupported };
  487. end;
  488. _MOVE : Begin
  489. CurX2 := XPos2;
  490. CurY2 := YPos2;
  491. end;
  492. _DRAW: Begin
  493. curx2i:=trunc(CurX2);
  494. cury2i:=trunc(CurY2);
  495. xpos2i:=trunc(xpos2);
  496. ypos2i:=trunc(ypos2);
  497. { this optimization doesn't matter that much
  498. if (curx2i=xpos2i) then
  499. begin
  500. if (cury2i=ypos2i) then
  501. putpixel(curx2i,cury2i,currentcolor)
  502. else if (cury2i+1=ypos2i) or
  503. (cury2i=ypos2i+1) then
  504. begin
  505. putpixel(curx2i,cury2i,currentcolor);
  506. putpixel(curx2i,ypos2i,currentcolor);
  507. end
  508. else
  509. Line(curx2i,cury2i,xpos2i,ypos2i);
  510. end
  511. else if (cury2i=ypos2i) then
  512. begin
  513. if (curx2i+1=xpos2i) or
  514. (curx2i=xpos2i+1) then
  515. begin
  516. putpixel(curx2i,cury2i,currentcolor);
  517. putpixel(xpos2i,cury2i,currentcolor);
  518. end
  519. else
  520. Line(curx2i,cury2i,xpos2i,ypos2i);
  521. end
  522. else
  523. }
  524. Line(curx2i,cury2i,xpos2i,ypos2i);
  525. CurX2:=xpos2;
  526. CurY2:=ypos2;
  527. end;
  528. else
  529. Begin
  530. end;
  531. end;
  532. Inc(counter);
  533. end; { end while }
  534. if Currenttextinfo.direction=VertDir then
  535. y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
  536. else
  537. x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
  538. end;
  539. setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
  540. end;
  541. { restore write mode }
  542. CurrentWriteMode := WriteMode;
  543. end;
  544. procedure OutText(const TextString : string);
  545. var x,y:smallint;
  546. begin
  547. { Save CP }
  548. x:=CurrentX;
  549. y:=CurrentY;
  550. OutTextXY(CurrentX,CurrentY,TextString);
  551. { If the direction is Horizontal and the justification left }
  552. { then and only then do we update the CP }
  553. if (Currenttextinfo.direction=HorizDir) and
  554. (Currenttextinfo.horiz=LeftText) then
  555. inc(x,textwidth(TextString));
  556. { Update the CP }
  557. CurrentX := X;
  558. CurrentY := Y;
  559. end;
  560. procedure SetTextJustify(horiz,vert : word);
  561. begin
  562. if (horiz<0) or (horiz>2) or
  563. (vert<0) or (vert>2) then
  564. begin
  565. _graphresult:=grError;
  566. exit;
  567. end;
  568. Currenttextinfo.horiz:=horiz;
  569. Currenttextinfo.vert:=vert;
  570. end;
  571. procedure SetTextStyle(font,direction : word;charsize : word);
  572. var
  573. f : file;
  574. Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder *}
  575. Length, Current: longint;
  576. FontData: Pchar;
  577. hp : pchar;
  578. i : longint;
  579. begin
  580. if font>installedfonts then
  581. begin
  582. _graphresult:=grInvalidFontNum;
  583. exit;
  584. end;
  585. Currenttextinfo.font:=font;
  586. if (direction<>HorizDir) and (direction<>VertDir) then
  587. direction:=HorizDir;
  588. Currenttextinfo.direction:=direction;
  589. { According to the Turbo Pascal programmer's reference }
  590. { maximum charsize for bitmapped font is 10 }
  591. if (CurrentTextInfo.Font = DefaultFont) and (Charsize > 10) then
  592. Currenttextinfo.charsize:=10
  593. else if charsize<1 then
  594. Currenttextinfo.charsize:=1
  595. else
  596. Currenttextinfo.charsize:=charsize;
  597. { This is only valid for stroked fonts }
  598. {$ifdef logging}
  599. LogLn('(org_to_cap - org_to_dec): ' + strf(
  600. fonts[Currenttextinfo.font].header.org_to_cap-
  601. fonts[Currenttextinfo.font].header.org_to_dec));
  602. {$endif logging}
  603. if (charsize <> usercharsize) then
  604. Case CharSize of
  605. 1: Begin
  606. CurrentXRatio := 0.55;
  607. CurrentYRatio := 0.55;
  608. End;
  609. 2: Begin
  610. CurrentXRatio := 0.65;
  611. CurrentYRatio := 0.65;
  612. End;
  613. 3: Begin
  614. CurrentXRatio := 0.75;
  615. CurrentYRatio := 0.75;
  616. End;
  617. 4: Begin
  618. CurrentXRatio := 1.0;
  619. CurrentYRatio := 1.0;
  620. End;
  621. 5: Begin
  622. CurrentXRatio := 1.3;
  623. CurrentYRatio := 1.3;
  624. End;
  625. 6: Begin
  626. CurrentXRatio := 1.65;
  627. CurrentYRatio := 1.65
  628. End;
  629. 7: Begin
  630. CurrentXRatio := 2.0;
  631. CurrentYRatio := 2.0;
  632. End;
  633. 8: Begin
  634. CurrentXRatio := 2.5;
  635. CurrentYRatio := 2.5;
  636. End;
  637. 9: Begin
  638. CurrentXRatio := 3.0;
  639. CurrentYRatio := 3.0;
  640. End;
  641. 10: Begin
  642. CurrentXRatio := 4.0;
  643. CurrentYRatio := 4.0;
  644. End
  645. End;
  646. { if this is a stroked font then load it if not already loaded }
  647. { into memory... }
  648. if (font>DefaultFont) and not assigned(fonts[font].instr) then
  649. begin
  650. assign(f,bgipath+fonts[font].name+'.CHR');
  651. {$i-}
  652. reset(f,1);
  653. {$i+}
  654. if ioresult<>0 then
  655. begin
  656. _graphresult:=grFontNotFound;
  657. Currenttextinfo.font:=DefaultFont;
  658. exit;
  659. end;
  660. {* Read in the file prefix *}
  661. BlockRead(F, Prefix, Prefix_Size);
  662. hp:=Prefix;
  663. i:=0;
  664. while (hp[i] <> chr($1a)) do Inc(i);
  665. move(hp[i+1],fonts[font].PHeader,sizeof(TFHeader));
  666. (* Read in the Header file *)
  667. BlockRead(F,fonts[font].Header,Sizeof(THeader));
  668. BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(smallint));
  669. {* Load the character width table into memory. *}
  670. BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
  671. {* Determine the length of the stroke database. *}
  672. current := FilePos( f ); {* Current file location *}
  673. Seek( f, FileSize(F)); {* Go to the end of the file *}
  674. length := FilePos( f ); {* Get the file length *}
  675. Seek( f, current); {* Restore old file location *}
  676. {* Load the stroke database. *}
  677. { also allocate space for Null character }
  678. Getmem(FontData, Length+1); {* Create space for font data *}
  679. BlockRead(F, FontData^, length-current); {* Load the stroke data *}
  680. FontData[length-current+1] := #0;
  681. if fonts[font].header.Signature<> SIGNATURE then
  682. begin
  683. _graphResult:=grInvalidFont;
  684. Currenttextinfo.font:=DefaultFont;
  685. Freemem(FontData, Length+1);
  686. exit;
  687. end;
  688. fonts[font].instr:=FontData;
  689. fonts[font].instrLength:=Length+1;
  690. if not testfont(Prefix) then
  691. begin
  692. _graphresult:=grInvalidFont;
  693. Currenttextinfo.font:=DefaultFont;
  694. Freemem(FontData, Length+1);
  695. end;
  696. close(f);
  697. end;
  698. end;
  699. procedure SetUserCharSize(Multx,Divx,Multy,Divy : word);
  700. begin
  701. CurrentXRatio := MultX / DivX;
  702. CurrentYRatio := MultY / DivY;
  703. end;
  704. {
  705. $Log$
  706. Revision 1.3 2002-07-18 07:11:11 pierre
  707. merged from FIXES branch: DrawTextBackground support
  708. Revision 1.2 2000/07/13 11:33:47 michael
  709. + removed logs
  710. }