'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright by Weinmann Holzbausystemtechnik GmbH (c) 2005
'
' Filename:
'
' Description:
'
' Author:		tb32jar
'
' Date:			20050114
'
' Version:		V0.01
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SUB MAIN

 DIM dPX(16)

	DIM i

 DIM sIni
 DIM P0_Title

 const MACROTITLE = "Macro"

 DIM T1_Title
 DIM T2_Title
 DIM T3_Title
 DIM T4_Title
 DIM T5_Title
 DIM T6_Title
 DIM F_Title

 DIM STRFault
 DIM STRFaultAll

 'Holen Parameterbezeichnungen abhaengig von der Landessprache
 sIni = "l" + GETACTUALLANGUAGE() + ".ini"

' ==========================================================================

	IF NOT FINDFIRSTSELECTED THEN
		DIM BEAMCOUNTER

		BEAMCOUNTER = GETCOUNTTYPE(CalcType("LS"))
		BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("QS"))
		BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("BT4"))
		BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("BT6"))

		IF BEAMCOUNTER = 1 THEN
			IF GETCOUNTTYPE(CalcType("LS")) = 1 THEN
				FINDFIRSTTYPE(CalcType("LS"))
			END IF
			IF GETCOUNTTYPE(CalcType("QS")) = 1 THEN
				FINDFIRSTTYPE(CalcType("QS"))
			END IF
			IF GETCOUNTTYPE(CalcType("BT4")) = 1 THEN
				FINDFIRSTTYPE(CalcType("BT4"))
			END IF
			IF GETCOUNTTYPE(CalcType("BT6")) = 1 THEN
				FINDFIRSTTYPE(CalcType("BT6"))
			END IF
		ELSE
		  MsgBox GETPRIVATEPROFILESTRING("Fehler", "F1", " ", sIni),vbOkOnly+vbCritical+vbSystemModal,MACROTITLE
		  exit sub
		END IF
	END IF

	IF NOT (ISBEAM OR (ISBEAMPROCESSING AND SELECTPARENTBEAM())) THEN
	  MsgBox GETPRIVATEPROFILESTRING("Fehler", "F2", " ", sIni),vbOkOnly+vbCritical+vbSystemModal,MACROTITLE
	  exit sub
	END IF

' ==========================================================================

 P0_Title = GETPRIVATEPROFILESTRING("GENERAL", "P0", " ", sIni)


	FOR i = LBOUND(dPX) TO UBOUND(dPX)
		dPX(i) = 0.0
	NEXT

 'T1_Title = GETPRIVATEPROFILESTRING("Anfang/Ende_orientiert", "T1", " ", sIni)
 'T2_Title = GETPRIVATEPROFILESTRING("Anfang/Ende_orientiert", "T2", " ", sIni)


 'IF MsgBox(T1_Title & vbCrLf & vbCrLf & T2_Title, vbYesNo + vbQuestion, MACROTITLE) = vbYes THEN
 '		dPX(16) = 2
'	ELSE
'		dPX(16) = 1
'	END IF


	DO
  T1_Title = GETPRIVATEPROFILESTRING("Ebene", "T1", " ", sIni)
  T2_Title = GETPRIVATEPROFILESTRING("Ebene", "T2", " ", sIni)
  T3_Title = GETPRIVATEPROFILESTRING("Ebene", "T3", " ", sIni)
  T4_Title = GETPRIVATEPROFILESTRING("Ebene", "T4", " ", sIni)
  T5_Title = GETPRIVATEPROFILESTRING("Ebene", "T5", " ", sIni)
  T6_Title = GETPRIVATEPROFILESTRING("Ebene", "T6", " ", sIni)

'		dPX(0) = InputBoxI(T1_Title & vbCrLf & vbCrLf & T2_Title & vbCrLf & vbCrLf & T3_Title & vbCrLf & T4_Title & vbCrLf & T5_Title & vbCrLf & T6_Title & vbCrLf & vbCrLf,MACROTITLE,2)
		dPX(0) = 2


		IF bInputBoxCancel = 1 THEN
			EXIT SUB
		END IF

		IF (1 <= dPX(0)) and (dPX(0) <= 4)  THEN
			EXIT DO
		ELSE
			F_Title = GETPRIVATEPROFILESTRING("Fehler", "F3", " ", sIni)
			MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
		END IF
	LOOP

	dPX(1) = InputBoxF("P1:",MACROTITLE,100)
	IF bInputBoxCancel = 1 THEN
		EXIT SUB
	END IF

	dPX(2) = InputBoxF("P2:",MACROTITLE,20)
	IF bInputBoxCancel = 1 THEN
		EXIT SUB
	END IF

	'Achtung, maximal 40 Zeichen!
	'Es sind alle lesbaren Zeichen des ASCII Zeichensatzes erlaubt. Ausnahmen:  ,<>:#$%=;!\|
	DO

		dPX(3) = "Abc_xyz_1234567890"
'		dPX(3) = "1234567890123456789012345678901234567890"
		dPX(3) = InputBox("P3:",MACROTITLE,dPX(3))
		IF bInputBoxCancel = 1 THEN
			EXIT SUB
		END IF

		'MsgBox LEN(dPX(3)),vbOkOnly + vbCritical + vbSystemModal,"Error"

		IF	INSTR(dPX(3),",") + INSTR(dPX(3),"<") + INSTR(dPX(3),">") + INSTR(dPX(3),":") + INSTR(dPX(3),"#") + INSTR(dPX(3),"$") + INSTR(dPX(3),"%") + INSTR(dPX(3),"=") + INSTR(dPX(3),";") + INSTR(dPX(3),"!") + INSTR(dPX(3),"\") + INSTR(dPX(3),"|") < 1 AND (LEN(dPX(3)) < 41) THEN
			EXIT DO
		ELSE
			STRFaultAll = ", < > : # $ % = ; ! \ |"
			IF INSTR(dPX(3),",") > 0 THEN
				STRFault = ","
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"<") > 0 THEN
				STRFault = "<"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),">") > 0 THEN
				STRFault = ">"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),":") > 0 THEN
				STRFault = ":"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"#") > 0 THEN
				STRFault = "#"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"$") > 0 THEN
				STRFault = "$"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"%") > 0 THEN
				STRFault = "%"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"=") > 0 THEN
				STRFault = "="
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),";") > 0 THEN
				STRFault = ";"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"!") > 0 THEN
				STRFault = "!"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"\") > 0 THEN
				STRFault = "\"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF INSTR(dPX(3),"|") > 0 THEN
				STRFault = "|"
				F_Title = STRFaultAll + vbCrLf + vbCrLf + STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F7", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF
			IF  LEN(dPX(3)) > 40 THEN
				STRFault = "...40" + vbCrLf + dPX(3)
				F_Title = STRFault + vbCrLf + vbCrLf + GETPRIVATEPROFILESTRING("Fehler", "F8", " ", sIni)
				MsgBox F_Title,vbOkOnly + vbCritical + vbSystemModal,"Error"
			END IF

		END IF

	LOOP

	'KN X-Position ,e-Bezugsebene,Text,y,z,index
	KN dPX(1) ,dPX(0),dPX(3),dPX(2),0,0

END SUB

MAIN
