************************************************************************ ************************************************************************ SUBROUTINE TXTEWRI (TXT, STRING, - TXT2, RET, *) ************************************************************************ * * * EDITIEREN EINES TEXTES TXT * * * ************************************************************************ * * * INPUT-PARAMETER: * * ---------------- * * TXT I*4 TEXTADRESSE * * STRING C*70 NEUER TEXT * * * * OUTPUT-PARAMETER: * * ----------------- * * TXT2 I*4 TEXTADRESSE * * * * RETURNCODES: * * ------------ * * 20104 ELEMENTTYP WIRD NICHT UNTERSTÜTZT * * * ************************************************************************ * * * * . AUTOR : DBB * * * FIRMA : MRO * * * TEL. : 069/8305-2876 (DBB) * 18.10.93 * * * * * . PROGRAMMIERSPRACHE : VS-FORTRAN V2R4M0 * * * * * * . UNTERSTÜTZUNG NEUE TEXT+DIM MITTELS MIGRATION ROUTINES * 07.06.97 * * . TEXT2 HAT KEIN THICKNESS ATTRIBUT * 09.06.97 * * * * ************************************************** 22.07.97 ** DBB ***** IMPLICIT NONE *----------------------------------------------------------------------- * PARAMETER-DEKLARATIONEN *----------------------------------------------------------------------- INTEGER TXT CHARACTER*70 STRING INTEGER TXT2 INTEGER RET *----------------------------------------------------------------------- * VARIABLEN-DEKLARATIONEN *----------------------------------------------------------------------- REAL*8 ANG REAL*8 CSPA(255) INTEGER DUMMY CHARACTER*8 DUMMY8 INTEGER IBOXED INTEGER ICSET(255) INTEGER IPAR INTEGER ISHO, IPIC, ICOL, IBLI, ITHK, ILNT INTEGER ISTAND INTEGER ITYPTX INTEGER IUSTH INTEGER IUSTV INTEGER JDESC(255) INTEGER LAYER CHARACTER*70 LIDEN * CHARACTER*(70X255) CHARACTER*500 LTEXT INTEGER NBCHAR(255) INTEGER NIDEN INTEGER NSTEXT INTEGER NUMLIN(255) REAL*8 PT(2) REAL*8 SIZE(2,255) REAL*8 SLANT(255) REAL*8 XLINSP * * GMA VARIABLE FUER RESETX * INTEGER*4 RETI4(12) REAL*8 RETR8(12) INTEGER*4 RETLCHAR(5) CHARACTER*80 RETCHAR(5) *----------------------------------------------------------------------- * PROGRAMM-RUMPF *----------------------------------------------------------------------- * WRITE(6,*) 'TXTEWRI 1:' RET = 0 * FEHLERVAR. INITIAL. CALL RETINI *----------------------------------------------------------------------- * TEXTCHARACTERISTIKA HOLEN *----------------------------------------------------------------------- * TEXT HOLEN CALL GIRTXD2 (1, TXT, - ITYPTX, NSTEXT, NUMLIN, NBCHAR, LTEXT, IPAR, - PT, ANG, - ISTAND, XLINSP, IUSTV, IUSTH, - ICSET, SIZE, CSPA, SLANT, - RET, *998) IF (ITYPTX .NE. 1) THEN RET = 20104 * GMA CALL RETSETC( 4, 'NOTE') * CALL RETSET ('TXTEWRI ', RET) RETLCHAR(1) = 4 RETCHAR(1) = 'NOTE' CALL RETSETX ('TXTEWRI ', - 0, RETI4, - 0, RETR8, - 1, RETLCHAR, RETCHAR, - RET) GOTO 998 ENDIF IF (IPAR .NE. 0) THEN RET = 20104 * GMA CALL RETSETC(21, 'PARAMETRISIERTER TEXT') * CALL RETSET ('TXTEWRI ', RET) RETLCHAR(1) = 21 RETCHAR(1) = 'PARAMETRISIERTER TEXT' CALL RETSETX ('TXTEWRI ', - 0, RETI4, - 0, RETR8, - 1, RETLCHAR, RETCHAR, - RET) GOTO 998 ENDIF * TEXT-PARMS HOLEN CALL GIRDTG2 (1, TXT, - ITYPTX, IBOXED, NSTEXT, IPAR, - PT, ANG, - ISTAND, XLINSP, IUSTV, IUSTH, - RET, *998) IBOXED = IBOXED+1 * LAYER VON TXT HOLEN CALL GIRLAY (1, TXT, - LAYER, RET, *998) * FARBE,... VON TXT HOLEN CALL GIRVIS (1, TXT, - ISHO, IPIC, ICOL, IBLI, ITHK, ILNT, RET, *998) *----------------------------------------------------------------------- * TEXT ERZEUGEN, CHARACTERISTIKA ÄNDERN *----------------------------------------------------------------------- * TEXT ERZEUGEN JDESC(1) = 1 NUMLIN(1) = 1 CALL TRIMLEN (STRING, - NBCHAR(1), RET, *998) LTEXT = STRING CALL GCDTEX (1, NSTEXT, NUMLIN, NBCHAR, JDESC, LTEXT, PT, ANG, - TXT2, RET, *998) * CHARACTERISTIKA ÄNDERN WRITE (DUMMY8, '(A)') XLINSP CALL GCCTXD2 (1, TXT2, 0, 'LINSPA ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') IUSTH CALL GCCTXD2 (1, TXT2, 0, 'HORJUS ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') IUSTV CALL GCCTXD2 (1, TXT2, 0, 'VERJUS ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') IBOXED CALL GCCTXD2 (1, TXT2, 0, 'FRAME ', DUMMY8, RET, *997) * WRITE (DUMMY8, '(A)') 1 * CALL GCCTXD2 (1, TXT2, 0, 'LEAEXT ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') ISTAND CALL GCCTXD2 (1, TXT2, 0, 'STANDA ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') ICSET(1) CALL GCCTXD2 (1, TXT2, 0, 'FONTID ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') SIZE(1,1) CALL GCCTXD2 (1, TXT2, 0, 'HEIGHT ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') SIZE(2,1) CALL GCCTXD2 (1, TXT2, 0, 'WIDTH ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') CSPA(1) CALL GCCTXD2 (1, TXT2, 0, 'CHASPA ', DUMMY8, RET, *997) WRITE (DUMMY8, '(A)') SLANT(1) CALL GCCTXD2 (1, TXT2, 0, 'SLANT ', DUMMY8, RET, *997) * LAYER TXT2 ÄNDERN CALL GICLAY (1, TXT2, LAYER, - RET, *997) * FARBE,... VON TXT2 ÄND. CALL GICCOL (1, TXT2, ICOL, - RET, *997) CALL GICBLI (1, TXT2, IBLI, - RET, *997) CALL GICTHK (1, TXT2, ITHK, * - RET, *997) - RET, *100) IF (.FALSE.) THEN 100 IF (RET .NE. 453) GOTO 997 RET = 0 CALL RETINI ENDIF *----------------------------------------------------------------------- * IDENTIFIER VON TXT ÜBERNEHMEN, TXT LÖSCHEN *----------------------------------------------------------------------- * ATTRIBUTE KOPIEREN CALL ATTCOPY (TXT, TXT2, - RET, *997) * IDENT TXT HOLEN CALL GIRIDE (1, TXT, - NIDEN, LIDEN, RET, *997) * TXT LÖSCHEN CALL GIERAS (1, TXT, RET, *997) * IDENT AN TXT2 IF (NIDEN .NE. 0) - CALL GICIDE (1, TXT2, NIDEN, LIDEN, - RET, *998) ************************************************************************ RETURN 0 * FEHLERBEHANDLUNG 997 CALL GIERAS (1, TXT2, DUMMY, *998) 998 CALL RETPUT ('TXTEWRI ', RET) 999 RETURN 1 END