25'ten fazla konu seçemezsiniz Konular bir harf veya rakamla başlamalı, kısa çizgiler ('-') içerebilir ve en fazla 35 karakter uzunluğunda olabilir.
 
 
 
 
 

461 satır
16 KiB

  1. unit ultsTextBlock;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils,
  6. utsTextSuite,
  7. ultsTypes;
  8. function ltsTextBlockGetRect (const aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall;
  9. function ltsTextBlockGetWidth (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  10. function ltsTextBlockGetHeight (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  11. function ltsTextBlockGetFlags (const aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall;
  12. function ltsTextBlockGetTop (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  13. function ltsTextBlockGetLeft (const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  14. function ltsTextBlockGetVertAlign (const aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall;
  15. function ltsTextBlockGetHorzAlign (const aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall;
  16. function ltsTextBlockGetClipping (const aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall;
  17. function ltsTextBlockGetColor (const aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall;
  18. function ltsTextBlockGetFont (const aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall;
  19. function ltsTextBlockSetTop (const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall;
  20. function ltsTextBlockSetLeft (const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall;
  21. function ltsTextBlockSetVertAlign (const aHandle: TltsTextBlockHandle; const aValue: TtsVertAlignment): TltsErrorCode; stdcall;
  22. function ltsTextBlockSetHorzAlign (const aHandle: TltsTextBlockHandle; const aValue: TtsHorzAlignment): TltsErrorCode; stdcall;
  23. function ltsTextBlockSetClipping (const aHandle: TltsTextBlockHandle; const aValue: TtsClipping): TltsErrorCode; stdcall;
  24. function ltsTextBlockSetColor (const aHandle: TltsTextBlockHandle; const aValue: TtsColor4f): TltsErrorCode; stdcall;
  25. function ltsTextBlockSetFont (const aHandle: TltsTextBlockHandle; const aValue: TltsFontHandle): TltsErrorCode; stdcall;
  26. function ltsTextBlockGetActualHeight(const aHandle: TltsTextBlockHandle): Integer; stdcall;
  27. function ltsTextBlockGetTextWidthA (const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): Integer; stdcall;
  28. function ltsTextBlockGetTextWidthW (const aHandle: TltsTextBlockHandle; const aText: PWideChar): Integer; stdcall;
  29. function ltsTextBlockTextOutA (const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): TltsErrorCode; stdcall;
  30. function ltsTextBlockTextOutW (const aHandle: TltsTextBlockHandle; const aText: PWideChar): TltsErrorCode; stdcall;
  31. implementation
  32. uses
  33. ultsUtils;
  34. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  35. //TextBlock/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  36. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  37. function ltsTextBlockGetRect(const aHandle: TltsTextBlockHandle; var aValue: TtsRect): TltsErrorCode; stdcall;
  38. var
  39. b: TtsTextBlock;
  40. begin
  41. try
  42. result := ltsErrNone;
  43. if CheckTextBlockHandle(aHandle, b)
  44. then aValue := b.Rect
  45. else result := LastErrorCode;
  46. except
  47. on ex: Exception do begin
  48. SetLastError(ex);
  49. result := LastErrorCode;
  50. end;
  51. end;
  52. end;
  53. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  54. function ltsTextBlockGetWidth(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  55. var
  56. b: TtsTextBlock;
  57. begin
  58. try
  59. result := ltsErrNone;
  60. if CheckTextBlockHandle(aHandle, b)
  61. then aValue := b.Width
  62. else result := LastErrorCode;
  63. except
  64. on ex: Exception do begin
  65. SetLastError(ex);
  66. result := LastErrorCode;
  67. end;
  68. end;
  69. end;
  70. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  71. function ltsTextBlockGetHeight(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  72. var
  73. b: TtsTextBlock;
  74. begin
  75. try
  76. result := ltsErrNone;
  77. if CheckTextBlockHandle(aHandle, b)
  78. then aValue := b.Height
  79. else result := LastErrorCode;
  80. except
  81. on ex: Exception do begin
  82. SetLastError(ex);
  83. result := LastErrorCode;
  84. end;
  85. end;
  86. end;
  87. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  88. function ltsTextBlockGetFlags(const aHandle: TltsTextBlockHandle; var aValue: TtsBlockFlags): TltsErrorCode; stdcall;
  89. var
  90. b: TtsTextBlock;
  91. begin
  92. try
  93. result := ltsErrNone;
  94. if CheckTextBlockHandle(aHandle, b)
  95. then aValue := b.Flags
  96. else result := LastErrorCode;
  97. except
  98. on ex: Exception do begin
  99. SetLastError(ex);
  100. result := LastErrorCode;
  101. end;
  102. end;
  103. end;
  104. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  105. function ltsTextBlockGetTop(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  106. var
  107. b: TtsTextBlock;
  108. begin
  109. try
  110. result := ltsErrNone;
  111. if CheckTextBlockHandle(aHandle, b)
  112. then aValue := b.Top
  113. else result := LastErrorCode;
  114. except
  115. on ex: Exception do begin
  116. SetLastError(ex);
  117. result := LastErrorCode;
  118. end;
  119. end;
  120. end;
  121. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  122. function ltsTextBlockGetLeft(const aHandle: TltsTextBlockHandle; var aValue: Integer): TltsErrorCode; stdcall;
  123. var
  124. b: TtsTextBlock;
  125. begin
  126. try
  127. result := ltsErrNone;
  128. if CheckTextBlockHandle(aHandle, b)
  129. then aValue := b.Left
  130. else result := LastErrorCode;
  131. except
  132. on ex: Exception do begin
  133. SetLastError(ex);
  134. result := LastErrorCode;
  135. end;
  136. end;
  137. end;
  138. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  139. function ltsTextBlockGetVertAlign(const aHandle: TltsTextBlockHandle; var aValue: TtsVertAlignment): TltsErrorCode; stdcall;
  140. var
  141. b: TtsTextBlock;
  142. begin
  143. try
  144. result := ltsErrNone;
  145. if CheckTextBlockHandle(aHandle, b)
  146. then aValue := b.VertAlign
  147. else result := LastErrorCode;
  148. except
  149. on ex: Exception do begin
  150. SetLastError(ex);
  151. result := LastErrorCode;
  152. end;
  153. end;
  154. end;
  155. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  156. function ltsTextBlockGetHorzAlign(const aHandle: TltsTextBlockHandle; var aValue: TtsHorzAlignment): TltsErrorCode; stdcall;
  157. var
  158. b: TtsTextBlock;
  159. begin
  160. try
  161. result := ltsErrNone;
  162. if CheckTextBlockHandle(aHandle, b)
  163. then aValue := b.HorzAlign
  164. else result := LastErrorCode;
  165. except
  166. on ex: Exception do begin
  167. SetLastError(ex);
  168. result := LastErrorCode;
  169. end;
  170. end;
  171. end;
  172. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  173. function ltsTextBlockGetClipping(const aHandle: TltsTextBlockHandle; var aValue: TtsClipping): TltsErrorCode; stdcall;
  174. var
  175. b: TtsTextBlock;
  176. begin
  177. try
  178. result := ltsErrNone;
  179. if CheckTextBlockHandle(aHandle, b)
  180. then aValue := b.Clipping
  181. else result := LastErrorCode;
  182. except
  183. on ex: Exception do begin
  184. SetLastError(ex);
  185. result := LastErrorCode;
  186. end;
  187. end;
  188. end;
  189. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  190. function ltsTextBlockGetColor(const aHandle: TltsTextBlockHandle; var aValue: TtsColor4f): TltsErrorCode; stdcall;
  191. var
  192. b: TtsTextBlock;
  193. begin
  194. try
  195. result := ltsErrNone;
  196. if CheckTextBlockHandle(aHandle, b)
  197. then aValue := b.CurrentColor
  198. else result := LastErrorCode;
  199. except
  200. on ex: Exception do begin
  201. SetLastError(ex);
  202. result := LastErrorCode;
  203. end;
  204. end;
  205. end;
  206. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  207. function ltsTextBlockGetFont(const aHandle: TltsTextBlockHandle; var aValue: TltsFontHandle): TltsErrorCode; stdcall;
  208. var
  209. b: TtsTextBlock;
  210. begin
  211. try
  212. result := ltsErrNone;
  213. if CheckTextBlockHandle(aHandle, b)
  214. then aValue := b.CurrentFont
  215. else result := LastErrorCode;
  216. except
  217. on ex: Exception do begin
  218. SetLastError(ex);
  219. result := LastErrorCode;
  220. end;
  221. end;
  222. end;
  223. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  224. function ltsTextBlockSetTop(const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall;
  225. var
  226. b: TtsTextBlock;
  227. begin
  228. try
  229. result := ltsErrNone;
  230. if CheckTextBlockHandle(aHandle, b)
  231. then b.Top := aValue
  232. else result := LastErrorCode;
  233. except
  234. on ex: Exception do begin
  235. SetLastError(ex);
  236. result := LastErrorCode;
  237. end;
  238. end;
  239. end;
  240. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  241. function ltsTextBlockSetLeft(const aHandle: TltsTextBlockHandle; const aValue: Integer): TltsErrorCode; stdcall;
  242. var
  243. b: TtsTextBlock;
  244. begin
  245. try
  246. result := ltsErrNone;
  247. if CheckTextBlockHandle(aHandle, b)
  248. then b.Left := aValue
  249. else result := LastErrorCode;
  250. except
  251. on ex: Exception do begin
  252. SetLastError(ex);
  253. result := LastErrorCode;
  254. end;
  255. end;
  256. end;
  257. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  258. function ltsTextBlockSetVertAlign(const aHandle: TltsTextBlockHandle; const aValue: TtsVertAlignment): TltsErrorCode; stdcall;
  259. var
  260. b: TtsTextBlock;
  261. begin
  262. try
  263. result := ltsErrNone;
  264. if CheckTextBlockHandle(aHandle, b)
  265. then b.VertAlign := aValue
  266. else result := LastErrorCode;
  267. except
  268. on ex: Exception do begin
  269. SetLastError(ex);
  270. result := LastErrorCode;
  271. end;
  272. end;
  273. end;
  274. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  275. function ltsTextBlockSetHorzAlign(const aHandle: TltsTextBlockHandle; const aValue: TtsHorzAlignment): TltsErrorCode; stdcall;
  276. var
  277. b: TtsTextBlock;
  278. begin
  279. try
  280. result := ltsErrNone;
  281. if CheckTextBlockHandle(aHandle, b)
  282. then b.HorzAlign := aValue
  283. else result := LastErrorCode;
  284. except
  285. on ex: Exception do begin
  286. SetLastError(ex);
  287. result := LastErrorCode;
  288. end;
  289. end;
  290. end;
  291. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  292. function ltsTextBlockSetClipping(const aHandle: TltsTextBlockHandle; const aValue: TtsClipping): TltsErrorCode; stdcall;
  293. var
  294. b: TtsTextBlock;
  295. begin
  296. try
  297. result := ltsErrNone;
  298. if CheckTextBlockHandle(aHandle, b)
  299. then b.Clipping := aValue
  300. else result := LastErrorCode;
  301. except
  302. on ex: Exception do begin
  303. SetLastError(ex);
  304. result := LastErrorCode;
  305. end;
  306. end;
  307. end;
  308. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  309. function ltsTextBlockSetColor(const aHandle: TltsTextBlockHandle; const aValue: TtsColor4f): TltsErrorCode; stdcall;
  310. var
  311. b: TtsTextBlock;
  312. begin
  313. try
  314. result := ltsErrNone;
  315. if CheckTextBlockHandle(aHandle, b)
  316. then b.CurrentColor := aValue
  317. else result := LastErrorCode;
  318. except
  319. on ex: Exception do begin
  320. SetLastError(ex);
  321. result := LastErrorCode;
  322. end;
  323. end;
  324. end;
  325. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  326. function ltsTextBlockSetFont(const aHandle: TltsTextBlockHandle; const aValue: TltsFontHandle): TltsErrorCode; stdcall;
  327. var
  328. b: TtsTextBlock;
  329. f: TtsFont;
  330. begin
  331. try
  332. result := ltsErrNone;
  333. if CheckTextBlockHandle(aHandle, b) and CheckFontHandle(aValue, f)
  334. then b.CurrentFont := f
  335. else result := LastErrorCode;
  336. except
  337. on ex: Exception do begin
  338. SetLastError(ex);
  339. result := LastErrorCode;
  340. end;
  341. end;
  342. end;
  343. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  344. function ltsTextBlockGetActualHeight(const aHandle: TltsTextBlockHandle): Integer; stdcall;
  345. var
  346. b: TtsTextBlock;
  347. begin
  348. try
  349. if CheckTextBlockHandle(aHandle, b)
  350. then result := b.GetActualBlockHeight
  351. else result := -1;
  352. except
  353. on ex: Exception do begin
  354. SetLastError(ex);
  355. result := -1;
  356. end;
  357. end;
  358. end;
  359. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  360. function ltsTextBlockGetTextWidthA(const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): Integer; stdcall;
  361. var
  362. b: TtsTextBlock;
  363. begin
  364. try
  365. if CheckTextBlockHandle(aHandle, b)
  366. then result := b.GetTextWidthA(aText)
  367. else result := -1;
  368. except
  369. on ex: Exception do begin
  370. SetLastError(ex);
  371. result := -1;
  372. end;
  373. end;
  374. end;
  375. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  376. function ltsTextBlockGetTextWidthW(const aHandle: TltsTextBlockHandle; const aText: PWideChar): Integer; stdcall;
  377. var
  378. b: TtsTextBlock;
  379. begin
  380. try
  381. if CheckTextBlockHandle(aHandle, b)
  382. then result := b.GetTextWidthW(aText)
  383. else result := -1;
  384. except
  385. on ex: Exception do begin
  386. SetLastError(ex);
  387. result := -1;
  388. end;
  389. end;
  390. end;
  391. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  392. function ltsTextBlockTextOutA(const aHandle: TltsTextBlockHandle; const aText: PAnsiChar): TltsErrorCode; stdcall;
  393. var
  394. b: TtsTextBlock;
  395. begin
  396. try
  397. result := ltsErrNone;
  398. if CheckTextBlockHandle(aHandle, b)
  399. then b.TextOutA(aText)
  400. else result := LastErrorCode;
  401. except
  402. on ex: Exception do begin
  403. SetLastError(ex);
  404. result := LastErrorCode;
  405. end;
  406. end;
  407. end;
  408. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  409. function ltsTextBlockTextOutW(const aHandle: TltsTextBlockHandle; const aText: PWideChar): TltsErrorCode; stdcall;
  410. var
  411. b: TtsTextBlock;
  412. begin
  413. try
  414. result := ltsErrNone;
  415. if CheckTextBlockHandle(aHandle, b)
  416. then b.TextOutW(aText)
  417. else result := LastErrorCode;
  418. except
  419. on ex: Exception do begin
  420. SetLastError(ex);
  421. result := LastErrorCode;
  422. end;
  423. end;
  424. end;
  425. end.