home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Exec 3 / CD_Magazyn_EXEC_nr_3.iso / Recent / biz / swood / FW_AllInOne.lha / Makros / FontLook < prev    next >
Text File  |  1998-01-25  |  17KB  |  647 lines

  1. /* Optimized with RexxOpt 1.7 */
  2.  
  3. Parse ARG FW
  4. if ~show('L',"rexxreqtools.library") then
  5. if ~addlib('rexxreqtools.library',0,-30,0) then;do
  6. 'ShowMessage 1 1 "Fehler...." "Benötige Libs:rexxreqtools.library" " A B B R U C H ! !" "Okay" "" ""'
  7. exit
  8. end
  9. IF ~show('L','tritonrexx.library') then
  10. IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN;DO
  11. 'ShowMessage 2 1 "Fehler...." "Benötige Libs:tritonrexx.library" "" "Abbruch" "" ""'
  12. exit
  13. END
  14. R='0A'X
  15. If FW='' then;do
  16. Address='FinalW'
  17. Options results
  18. STATUS PORTNAME
  19. FW=result
  20. End
  21. address(FW)
  22. SIGNAL ON SYNTAX
  23. address "REXX"
  24. If open('Hilfe',"S:FW_Paket.prefs","R") then;do
  25. HilfeVerz=readln('Hilfe')
  26. Call Close('Hilfe')
  27. End
  28. else HilfeVerz=''
  29. If open('pref','S:FW_FontLook.prefs','R')~=0 then;do
  30. Art=readln('pref')
  31. Ausgabe=readln('pref')
  32. Schnitte=readln('pref')
  33. Locher=readln('pref')
  34. Gesch=readln('pref')
  35. Speich=readln('pref')
  36. auswd=readln('pref')
  37. auswf=readln('pref')
  38. call close('pref')
  39. END
  40. else;do
  41. Art=0;Ausgabe=0;Locher=0
  42. Gesch=0;Speich=0
  43. auswd='';auswf='';Schnitte=0
  44. END
  45. ausw=''
  46. Artlist.0=2
  47. Artlist.1='Schriftartenverzeichnis'
  48. Artlist.2='einzelne Schriftart'
  49. Speichlist.0=3
  50. Speichlist.1='Speichern'
  51. Speichlist.2='Drucken'
  52. Speichlist.3='Beides'
  53. Geschlist.0=2
  54. Geschlist.1='normal'
  55. Geschlist.2='schnell'
  56. Ausgabelist.0=3
  57. Ausgabelist.1='Code'
  58. Ausgabelist.2='Layout'
  59. Ausgabelist.3='Übersicht'
  60. If Ausgabe~=1 then Disi=1
  61. else Disi=0
  62. If Locher=0 then LocherText="Nein"
  63. Else LocherText="Ja"
  64. o1="Geschwindigkeit: "||Geschlist.Gesch||", Lochermarken: "||LocherText
  65. o2="Speichern/Drucken: "||Speichlist.Speich
  66. apptags='TRCA_Name     FontLook',
  67. 'TRCA_LongName "FontLook"',
  68. 'TRCA_Info     "Makro für Finalwriter"',
  69. 'TRCA_Version  "4.1 registered"',
  70. 'TRCA_Release  "2"',
  71. 'TRCA_Date     "09.01.98"',
  72. 'TAG_END'
  73. windowtags=WindowID(1),
  74. WindowPosition('TRWP_CENTERDISPLAY'),
  75. WindowFlags('TRWF_NOMINTEXTWIDTH|TRWF_NOSIZEGADGET'),
  76. PubScreenName('FinalWriterPubScreen'),
  77. WindowTitle('FontLook'),
  78. BeginMenu('Projekt'),
  79. MenuItem('Voreinsteller...',102),
  80. 'ItemBarlabel',
  81. MenuItem('Q_Verlassen...',104),
  82. BeginMenu('?'),
  83. MenuItem('?_Info',101),
  84. MenuItem('H_Hilfe',103),
  85. 'HorizGroupAC SpaceS',
  86. 'VertGroupAC SpaceS',
  87. CycleGadget('Artlist',Art,11) 'TRAT_Flags TRCY_RIGHTLABELS',
  88. 'HorizGroupAC',
  89. GetEntryButton(12),
  90. StringGadget('',13),
  91. 'EndGroup',
  92. 'Space',
  93. 'HorizGroupAC',
  94. CycleGadget('Ausgabelist',Ausgabe,14) 'TRAT_Flags TRCY_RIGHTLABELS',
  95. 'SpaceS',
  96. CheckBox(15) 'TRAT_VALUE' Schnitte 'TRAT_DISABLED' Disi,
  97. 'SpaceS',
  98. TextID("_Schriftschnitte",15),
  99. 'EndGroup',
  100. 'Space',
  101. 'HorizSeparator',
  102. 'SpaceS',
  103. TextH(o1) 'TRAT_ID 16',
  104. TextH(o2) 'TRAT_ID 17',
  105. 'SpaceS',
  106. Progress(100,0,7),
  107. 'SpaceS',
  108. 'HorizGroupSA',
  109. TextN("0"),
  110. 'SpaceB SpaceB',
  111. TextN("25"),
  112. 'SpaceB SpaceB',
  113. TextN("50"),
  114. 'SpaceB SpaceB',
  115. TextN("75"),
  116. 'SpaceB SpaceB',
  117. TextN("100"),
  118. 'EndGroup',
  119. 'SpaceS',
  120. 'HorizGroupEC',
  121. Button(' _Anwenden ',1),
  122. 'SpaceS',
  123. Button('Ab_bruch',2),
  124. 'EndGroup SpaceS',
  125. 'EndGroup SpaceS',
  126. 'EndGroup SpaceS',
  127. 'EndProject'
  128. app=TR_CREATEAPP('TRCA_Name FontLook')
  129. IF app~='00000000'x THEN;DO
  130. window1=TR_OPENPROJECT(app,windowtags)
  131. IF window1~='00000000'x THEN;DO
  132. If Art=0 then CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  133. If Art=1 then CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  134. ende=0
  135. DO WHILE ende~=1
  136. CALL TR_WAIT(app,'')
  137. DO WHILE TR_HANDLEMSG(app,'event')
  138. IF event.trm_class='TRMS_CLOSEWINDOW' THEN ende=1
  139. IF event.trm_class='TRMS_NEWVALUE' THEN;DO
  140. SELECT
  141. WHEN event.trm_id=11 THEN;DO
  142. Art=event.trm_data
  143. If Art=0 then;do
  144. CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  145. ausw=auswd
  146. END
  147. If Art=1 then;do
  148. CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  149. ausw=auswf
  150. END
  151. END
  152. WHEN event.trm_id=14 THEN;do
  153. Ausgabe=event.trm_data
  154. If Ausgabe~=1 then Call TR_SETATTRIBUTE(window1,15,'TRAT_DISABLED',1)
  155. else Call TR_SETATTRIBUTE(window1,15,'TRAT_DISABLED',0)
  156. End
  157. WHEN event.trm_id=15 THEN;DO
  158. Schnitte=event.trm_data
  159. END
  160. OTHERWISE
  161. NOP
  162. END
  163. END
  164. IF event.trm_class='TRMS_ACTION' THEN;DO
  165. SELECT
  166. WHEN event.trm_id=12 THEN;Do
  167. If Art=0 then;do
  168. dir=rtfilerequest(auswd,,"Verzeichnis auswählen...",,"rt_pubscrname=FinalWriterPubScreen rtfi_flags = freqf_nofiles")
  169. if dir='' then auswd=auswd
  170. else auswd=dir
  171. CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswd)
  172. ausw=auswd
  173. END
  174. If Art=1 then;do
  175. pos=max(index(auswf,':'),lastpos('/',auswf))
  176. IF (pos~=0) THEN ops=Left(auswf,pos)
  177. ELSE ops=auswf
  178. file=rtfilerequest(ops,,"Font auswählen...","Start","rt_pubscrname=FinalWriterPubScreen")
  179. if file='' then auswf=auswf
  180. else auswf=file
  181. CALL TR_SETATTRIBUTE(window1,13,'TROB_String',auswf)
  182. ausw=auswf
  183. END
  184. END
  185. WHEN event.trm_id=1 THEN;Do
  186. ausw=TR_GETATTRIBUTE(window1,13,'TROB_String')
  187. CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',0)
  188. Call Programm
  189. END
  190. WHEN event.trm_id=2 THEN ende=1
  191. WHEN event.trm_id=101 THEN Call rtezrequest("Aus dem Makro-Paket:"||R||R||"FontLook V4.1 für FW"||R||"© 1998 Heiko Schröder","Danke für Ihre Registrierung.","Info","rt_pubscrname=FinalWriterPubScreen")
  192. WHEN event.trm_id=102 THEN Call Voreinstellung
  193. WHEN event.trm_id=103 THEN address command "run Multiview PUBSCREEN=FinalWriterPubScreen "||d2c(34)||HilfeVerz||"FontLook.guide"||d2c(34)
  194. WHEN event.trm_id=104 THEN ende=1
  195. OTHERWISE NOP
  196. END
  197. END
  198. END
  199. END
  200. CALL TR_CLOSEPROJECT(window1)
  201. END
  202. CALL TR_DELETEAPP(app)
  203. END
  204. ELSE
  205. CALL quit('Kann das Fenster nicht öffnen',10)
  206. Exit
  207. Programm:
  208. Temp="RAM:fonts"
  209. If ausw~='' then;do
  210. ausw='"'||ausw||'"'
  211. address command 'list ' ausw||' to=' Temp||' files lformat "%s%s"'
  212. END
  213. else;do
  214. If Art=0 then ret=rtezrequest("Kein Verzeichnis ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  215. If Art=1 then ret=rtezrequest("Kein Font ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  216. Call TR_SendMessage(window1,13,'TROM_ACTIVATE',0)
  217. Return
  218. END
  219. If OPEN('file',Temp,"R") then
  220. Laenge=Seek("file",0,"E")
  221. If Laenge=0 then;do
  222. If Art=0 then ret=rtezrequest("Verzeichnis ist leer...","_Abbruch","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  223. If Art=1 then ret=rtezrequest("Kein Font ausgewählt...","_Achso","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  224. address "REXX"
  225. Call close("file")
  226. Return
  227. END
  228. Call close("file")
  229. address command 'sort ' Temp Temp
  230. ret=rtezrequest("Das Makro benötigt ein leeres Dokument."R"Ihr jetziges Dokument wird gelöscht!","_Ja|_Nein","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  231. If ret=0 then Return
  232. Call open('file',Temp,"R")
  233. address(FW)
  234. ClearDoc FORCE
  235. c=0
  236. DO WHILE 1
  237. TR_HANDLEMSG(app,'event')
  238. IF event.trm_class='TRMS_ACTION' THEN
  239. If event.trm_id=2 THEN;do
  240. Call WH
  241. If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  242. leave
  243. End
  244. FondName=ReadLn('file')
  245. IF EOF('file') THEN;do
  246. Call close('file')
  247. Address command "delete ram:fonts QUIET"
  248. If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  249. leave
  250. END
  251. Stand=Seek("file",0,"C")
  252. schonweg=0
  253. If (Lastpos(".info",FondName)=0&Lastpos(".otag",FondName)=0&Lastpos(".type",FondName)=0&Lastpos(".afm",FondName)=0&Lastpos(".lib",FondName)=0) then;do
  254. If Schnitte=1 then
  255. Do g=1 to c
  256. If pos(upper(Schnitte.g),upper(FondName))~=0 then schonweg=1
  257. End
  258. If schonweg=0 then;do
  259. TextTool
  260. Font FondName
  261. If RC<=5 then;do
  262. Call FontBestimmen
  263. GetDocItemPrefs Decimal
  264. Punkt=Result
  265. If Punkt="Comma" then DocItemPrefs DECIMAL Period
  266. IF Gesch=2 THEN;do
  267. View 20
  268. RedrawOFF
  269. End
  270. Pagesetup Pagetype A4 Orient Tall Pages RightOnly
  271. SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1
  272. GraphicTool
  273. LinePrefs LineWt .5
  274. DrawLine 1 2 3.5 20 3.5
  275. if Ausgabe~=2 then DrawLine 1 2 26 20 26
  276. If Locher=1 then DrawLine 1 .5 14.85 1 14.85
  277. TextTool
  278. If Ausgabe=0 then;do
  279. Do i=0 to 14
  280. SetTab i*1.2+0.8 Right
  281. END
  282. NameFont="FWDocs/Codes-"||ShortFondName
  283. Justify Center
  284. Font Softsans
  285. FontSize 18
  286. Type ShortFondName;NewParagraph;NewParagraph
  287. a=-17
  288. Justify Left
  289. DO f=1 to 16
  290. Font Softsans
  291. FontSize 8
  292. zeile=''
  293. DO j=a+33 to a+47
  294. zeile=zeile|| d2c(9)||j|| d2c(32)|| d2c(j)
  295. END
  296. Type zeile;NewParagraph
  297. Font ShortFondName
  298. FontSize 24
  299. zeile=''
  300. DO j=a+33 to a+47
  301. zeile=zeile|| d2c(9)|| d2c(j)
  302. END
  303. Type zeile;NewParagraph
  304. a=a+15
  305. END
  306. Font Softsans
  307. FontSize 9
  308. Type d2c(9);NewParagraph
  309. Justify Right
  310. Type Date(E)" - "FullFondName
  311. END
  312. If Ausgabe=1 then;do
  313. Justify Center
  314. NameFont="FWDocs/Layout-"||ShortFondName
  315. Font Softsans
  316. FontSize 18
  317. Type ShortFondName;NewParagraph
  318. Justify Left
  319. Font FullFondName
  320. FontSize 8
  321. NewParagraph;Type "This is 8-point type - not easy to read!";NewParagraph
  322. FontSize 9
  323. Type "9-Point type is about the smallest readable size.";NewParagraph
  324. FontSize 10
  325. Type "With 10-point type, we have a normal text size.";NewParagraph
  326. FontSize 12
  327. Type "With some fonts, 12-point type is easier to read.";NewParagraph
  328. FontSize 14
  329. Type "14-point type is good for subheadings.";NewParagraph
  330. FontSize 16
  331. Type "For larger subheadings, try 16-point type.";NewParagraph
  332. FontSize 18
  333. Type "18-point type makes nice small headlines.";NewParagraph
  334. FontSize 24
  335. Type "24-point type is for medium headlines.";NewParagraph
  336. FontSize 36
  337. Type "36-point is for larger ones.";NewParagraph
  338. FontSize 48
  339. Type "48-point almost shouts!";NewParagraph
  340. FontSize 12
  341. Font SoftSans
  342. Type d2c(32);NewParagraph
  343. Type "Erweiterter Schriftcode";NewParagraph
  344. FontSize 10
  345. Font FullFondName
  346. DO j=128 BY 32 FOR 4
  347. Type XRange( d2c(j), d2c(j+31));NewParagraph
  348. End
  349. NewParagraph
  350. Type "Normal";NewParagraph
  351. FontSize 10
  352. Font FullFondName
  353. Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ";NewParagraph
  354. Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?";NewParagraph
  355. Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  356. NewParagraph;NewParagraph
  357. If Schnitte=1 then;do
  358. Font SoftSans
  359. Type "Bold";NewParagraph
  360. FontSize 10
  361. If exists(FullFondName||"_bold") then;do
  362. c=c+1;Schnitte.c=FullFondName||"_bold"
  363. Font Schnitte.c
  364. Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ";NewParagraph
  365. Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?";NewParagraph
  366. Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  367. End
  368. Else;do
  369. Font SoftSans
  370. Type "Dieser Schriftschnitt existiert nicht."
  371. End
  372. NewParagraph;NewParagraph
  373. Font SoftSans
  374. Type "Italic";NewParagraph
  375. FontSize 10
  376. If exists(FullFondName||"_italic") then;do
  377. c=c+1;Schnitte.c=FullFondName||"_italic"
  378. Font Schnitte.c
  379. Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ";NewParagraph
  380. Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?";NewParagraph
  381. Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  382. End
  383. Else;do
  384. Font SoftSans
  385. Type "Dieser Schriftschnitt existiert nicht."
  386. End
  387. NewParagraph;NewParagraph
  388. Font SoftSans
  389. Type "BoldItalic";NewParagraph
  390. FontSize 10
  391. If exists(FullFondName||"_bolditalic") then;do
  392. c=c+1;Schnitte.c=FullFondName||"_bolditalic"
  393. Font Schnitte.c
  394. Type "ABCDEFGHIJKLMNOPQRSTUVWXYZ";NewParagraph
  395. Type "abcdefghijklmnopqrstuvwxyz 1234567890 !@#$%^&*()-+=[]{}/:;,.?";NewParagraph
  396. Type "The quick brown fox jumps over the lazy dog. ÄÖÜäöüß"
  397. End
  398. Else;do
  399. Font SoftSans
  400. Type "Dieser Schriftschnitt existiert nicht."
  401. End
  402. NewParagraph;NewParagraph
  403. End
  404. Status BodyTextHeight
  405. th=result
  406. FG=26.24-2.113-th
  407. FG=FG*8%0.34
  408. FontSize FG
  409. Type d2c(9)
  410. Font SoftSans
  411. FontSize 8
  412. NewParagraph
  413. Justify Right
  414. Type Date(E)" - "FullFondName
  415. END
  416. If Ausgabe=2 then;do
  417. DokAnz=1;FontAnz=0
  418. Call FontBestimmen
  419. NameFont="FWDocs/Übersicht-"||Speichname
  420. Justify Center
  421. Font Softsans
  422. FontSize 18
  423. Type FontVerz||" - "||DokAnz;NewParagraph;NewParagraph;NewParagraph
  424. Justify Left
  425. Stand=Seek("file",0,"B")
  426. Do While 1
  427. FondName=ReadLn('file')
  428. IF EOF('file') THEN;do
  429. Backspace
  430. Backspace
  431. Namefont=NameFont||"-"||DokAnz
  432. leave
  433. End
  434. If (Lastpos(".info",FondName)=0&Lastpos(".otag",FondName)=0&Lastpos(".type",FondName)=0) then;do
  435. Font FondName
  436. a=RC
  437. If a=0 then;do
  438. Call FontBestimmen
  439. Font Softsans
  440. FontSize 11
  441. Type ShortFondName;NewParagraph
  442. Font FondName
  443. FontSize 11
  444. Status BodyTextHeight
  445. th1=result
  446. Type "THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG ÄÖÜ 0123456789"
  447. Status BodyTextHeight
  448. th2=result
  449. if th2>th1 then;do
  450. ShiftDown
  451. do While 1
  452. Cursor Left
  453. Delete
  454. Status BodyTextHeight
  455. th2=result
  456. If th2=th1 then Break
  457. End
  458. ShiftUp;NewParagraph
  459. end
  460. else NewParagraph
  461. Type "the quick brown fox jumps over the lazy dog äöüß"
  462. FontAnz=FontAnz+1
  463. END
  464. else;do
  465. ret=rtezrequest("FW kann diesen Font nicht anzeigen..."R||FondName" ist kein FW typischer Font...",,"ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  466. BackSpace
  467. End
  468. If FontAnz=12 then;do
  469. call WH
  470. UNameFont=NameFont||"-"||DokAnz
  471. If (Speich=1|Speich=3) then Save UNameFont
  472. If (Speich=2|Speich=3) then Print
  473. Cleardoc force
  474. DokAnz=DokAnz+1;FontAnz=0
  475. IF Gesch=2 THEN;do
  476. View 20
  477. RedrawOFF
  478. End
  479. If Punkt="Comma" then DocItemPrefs DECIMAL Period
  480. Pagesetup Pagetype A4 Orient Tall Pages RightOnly Top 0 Bottom 2.54 Left 0 Right 0
  481. SectionSetup Top 2.54 Bottom 2.54 Inside 2 Outside 1
  482. GraphicTool
  483. LinePrefs LineWt .5
  484. DrawLine 1 2 3.5 20 3.5
  485. If Locher=1 then DrawLine 1 .5 14.85 1 14.85
  486. Justify Center
  487. Font Softsans
  488. FontSize 18
  489. Type FontVerz||" - "||DokAnz;NewParagraph
  490. Justify Left
  491. end
  492. If a=0 then NewParagraph;NewParagraph
  493. End
  494. Stand=Seek("file",0,"C")
  495. prozent=Trunc(Stand/Laenge*100)
  496. CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',prozent)
  497. END
  498. END
  499. call WH
  500. If (Speich=1|Speich=3) then Save NameFont
  501. If (Speich=2|Speich=3) then Print
  502. Cleardoc force
  503. END
  504. else ret=rtezrequest("FW kann diesen Font nicht anzeigen..."R||FondName" ist kein FW typischer Font...",,"ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  505. end
  506. end
  507. prozent=Trunc(Stand/Laenge*100)
  508. CALL TR_SETATTRIBUTE(window1,7,'TRAT_Value',prozent)
  509. END
  510. If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  511. Return
  512. FontBestimmen:
  513. address(FW)
  514. Type d2c(32)
  515. BackSpace
  516. status FontPath
  517. FullFondName=result
  518. pos=max(index(FullFondName,':'),lastpos('/',FullFondName))
  519. IF (pos~=0) THEN ShortFondName=RIGHT(FullFondName,LENGTH(FullFondName)-pos)
  520. If Ausgabe=2 then;do
  521. FontVerz=Left(FullFondName,pos)
  522. FontVerz1=Left(FullFondName,pos-1)
  523. pos=max(index(FontVerz1,':'),lastpos('/',FontVerz1))
  524. IF (pos~=0) THEN SpeichName=RIGHT(FontVerz1,LENGTH(FontVerz1)-pos)
  525. END
  526. Return
  527. WH:
  528. address(FW)
  529. If Gesch=2 then View
  530. RedrawON
  531. Redraw
  532. Return
  533. Voreinstellung:
  534. oldGesch=Gesch;oldLocher=Locher;oldSpeich=Speich
  535. windowtags=WindowID(2),
  536. WindowPosition('TRWP_CENTERDISPLAY'),
  537. WindowFlags('TRWF_NOMINTEXTWIDTH|TRWF_NOSIZEGADGET'),
  538. PubScreenName('FinalWriterPubScreen'),
  539. WindowTitle('FontLook-Voreinsteller'),
  540. 'HorizGroupAC SpaceS',
  541. 'VertGroupA SpaceS',
  542. 'HorizGroupAC',
  543. TextID('Gesch_windigkeit: ',1),
  544. 'SpaceS',
  545. CycleGadget('Geschlist',Gesch-1,1) 'TRAT_Flags TRCY_RIGHTLABELS TRAT_Flags TRCY_RIGHTLABELS',
  546. 'EndGroup',
  547. 'SpaceS',
  548. 'HorizGroupAC',
  549. TextID('_Lochermarken:    ',2),
  550. 'SpaceS',
  551. CheckBox(2) 'TRAT_Value' Locher,
  552. 'EndGroup',
  553. 'SpaceS',
  554. 'HorizGroupAC',
  555. TextID('Speichern/_Drucken:',3),
  556. 'Spaces',
  557. CycleGadget('Speichlist',Speich-1,3) 'TRAT_Flags TRCY_RIGHTLABELS TRAT_Flags TRCY_RIGHTLABELS',
  558. 'EndGroup',
  559. 'SpaceS',
  560. 'HorizSeparator',
  561. 'SpaceS',
  562. 'HorizGroupEC',
  563. Button('_Sichern',15),
  564. 'SpaceS',
  565. Button('_Anwenden',10),
  566. 'SpaceS',
  567. Button('Ab_bruch',20),
  568. 'EndGroup SpaceS',
  569. 'EndGroup SpaceS',
  570. 'EndGroup SpaceS',
  571. 'EndProject'
  572. app2=TR_CREATEAPP('TRCA_Name FontLook2')
  573. IF app2 ~='00000000'x THEN;DO
  574. window2=TR_OPENPROJECT(app2,windowtags)
  575. IF window2 ~='00000000'x THEN;DO
  576. ende2=0
  577. DO WHILE ~ende2
  578. CALL TR_WAIT(app2,'')
  579. DO WHILE TR_HANDLEMSG(app2,'event')
  580. IF event.trm_class='TRMS_CLOSEWINDOW' THEN ende2=1
  581. IF event.trm_class='TRMS_NEWVALUE' THEN;DO
  582. SELECT
  583. WHEN event.trm_id=1 THEN Gesch=event.trm_data+1
  584. WHEN event.trm_id=2 THEN Locher=event.trm_data
  585. WHEN event.trm_id=3 THEN Speich=event.trm_data+1
  586. OTHERWISE NOP
  587. END
  588. End
  589. IF event.trm_class='TRMS_ACTION' THEN;DO
  590. SELECT
  591. WHEN event.trm_id=10 THEN Call Schreiben
  592. WHEN event.trm_id=15 THEN;Do
  593. Call open('pref','S:FW_FontLook.prefs','W')
  594. writeln('pref',Art)
  595. writeln("pref",Ausgabe)
  596. writeln("pref",Schnitte)
  597. writeln("pref",Locher)
  598. writeln("pref",Gesch)
  599. writeln("pref",Speich)
  600. writeln("pref",auswd)
  601. writeln("pref",auswf)
  602. Call close('pref')
  603. Call Schreiben
  604. END
  605. WHEN event.trm_id=20 THEN;Do
  606. Gesch=oldGesch;Locher=oldLocher;Speich=oldSpeich
  607. ende2=1
  608. END
  609. OTHERWISE NOP
  610. END
  611. END
  612. END
  613. END
  614. CALL TR_CLOSEPROJECT(window2)
  615. END
  616. CALL TR_DELETEAPP(app2)
  617. END
  618. ELSE
  619. CALL quit('Kann das Fenster nicht öffnen',10)
  620. Return
  621. Schreiben:
  622. If Locher=0 then LocherText="Nein"
  623. Else LocherText="Ja"
  624. o1="Geschwindigkeit: "||Geschlist.Gesch||", Lochermarken: "||LocherText
  625. o2="Speichern/Drucken: "||Speichlist.Speich
  626. Call TR_SETATTRIBUTE(window1,16,'TRAT_TEXT',o1)
  627. Call TR_SETATTRIBUTE(window1,17,'TRAT_TEXT',o2)
  628. ende2=1
  629. Return
  630. SYNTAX:
  631. CALL quit('Fehler' rc 'in Zeile' sigl '-' ERRORTEXT(rc)||R||SOURCELINE(sigl)||R||'Bitte informieren Sie den Autor...',20)
  632. quit:
  633. PARSE ARG message,rcode
  634. IF app ~='00000000'x THEN;DO
  635. IF message ~='' THEN
  636. ret=rtezrequest(message,"_Okay","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
  637. CALL TR_DELETEAPP(app)
  638. END
  639. ELSE
  640. IF message ~='' THEN;DO
  641. SAY message
  642. SAY
  643. OPTIONS PROMPT 'Bitte <RETURN> drücken'
  644. PULL taste
  645. END
  646. address command "flushtrx all"
  647. EXIT(rcode)