Attr-Class Attributes Write

From Vectorlab
Jump to: navigation, search


Export class attributes in a TAB separated text file. This routine needs A_TextureName to be loaded first. For VW12: Pay attention to the length of the file name: if it exceeds 32 characters, the file will create, but won't load with data. At the end you'll find an example which works as standalone. There are two variants: A_GetClassAttrs_WriteLn doesn't support custom markers, A_GetClassAttrs_WriteLn2 supports them. The markers data are separated by ";". By Orso B. Schmid


{ Orso ***************************** } 
{ analizes a class and writes to file. The file must be opened and closed elsewhere }
{ supports custom markers (from VW 13) }
{ this doesn't check if string is right class obj }
PROCEDURE A_GetClassAttrs_WriteLn(clN: STRING);
	CONST
		cTB = Chr(9);
		cB = ';';
	VAR
		cl_PF, cl_PB, cl_FF, cl_FB : RGBCOLOR;
		cl_FillN, clBegMark, clEndMark : STRING;
		cl_Mark : LONGINT;
		cl_MarkAng, cl_MarkThickBas : INTEGER;
		cl_MarkSize, cl_MarkWidth, cl_MarkThick : REAL;
		
	BEGIN
		{ RGBToColorIndex(RED, GREEN, BLUE, colorValue); }
		GetClPenFore(clN, cl_PF.RED, cl_PF.GREEN, cl_PF.BLUE);
		GetClPenBack(clN, cl_PB.RED, cl_PB.GREEN, cl_PB.BLUE);
		GetClFillFore(clN, cl_FF.RED, cl_FF.GREEN, cl_FF.BLUE);
		GetClFillBack(clN, cl_FB.RED, cl_FB.GREEN, cl_FB.BLUE);
		
		{ stores eventual fill name, if is bitmap pat, stores the name index }
		IF NOT GetClVectorFill(clN, cl_FillN) THEN
			cl_FillN := Concat(GetClFPat(clN));
		
		{ GetClFPat(clN) = something between 0 and 71, if dash is negative value }
		{ GetClLS(clN) = 0= empty, num= pattern, -num= dash }
		
		{ markers }
		{ set up default values if the new advanced routines fail }
		GetClassArrow(clN, cl_Mark, cl_MarkSize, cl_MarkAng);
		clBegMark := Concat(clN, cl_Mark, cl_MarkAng, cl_MarkSize, cB, '0', cB, '0', cB, '0');
		clEndMark := clBegMark;
		
		IF GetClassBeginningMarker(clN, cl_Mark, cl_MarkAng, cl_MarkSize, cl_MarkWidth, cl_MarkThickBas, cl_MarkThick) THEN
			clBegMark := Concat(cl_Mark, cB, cl_MarkAng, cB, cl_MarkSize, cB, cl_MarkWidth, cB, cl_MarkThickBas, cB, cl_MarkThick, cB);
		
		IF GetClassEndMarker(clN, cl_Mark, cl_MarkAng, cl_MarkSize, cl_MarkWidth, cl_MarkThickBas, cl_MarkThick) THEN
			clEndMark := Concat(cl_Mark, cB, cl_MarkAng, cB, cl_MarkSize, cB, cl_MarkWidth, cB, cl_MarkThickBas, cB, cl_MarkThick, cB);
		
		WriteLnMac(clN, cTB, 
			cl_PF.RED, cTB, cl_PF.GREEN, cTB, cl_PF.BLUE, cTB, 
			cl_PB.RED, cTB, cl_PB.GREEN, cTB, cl_PB.BLUE, cTB, 
			cl_FF.RED, cTB, cl_FF.GREEN, cTB, cl_FF.BLUE, cTB, 
			cl_FB.RED, cTB, cl_FB.GREEN, cTB, cl_FB.BLUE, cTB, 
			GetObjectVariableInt(GetObject(clN), 696), cTB, cl_FillN, cTB, 
			GetClLS(clN), cTB, GetClLW(clN), cTB, 
			clBegMark, cTB, clEndMark, cTB,
			GetClUseGraphic(clN), cTB, 
			A_TextureName(GetClTextureC(clN)), cTB, A_TextureName(GetClTextureD(clN)), cTB, A_TextureName(GetClTextureG(clN)), cTB, 
			A_TextureName(GetClTextureL(clN)), cTB, A_TextureName(GetClTextureR(clN)), cTB, A_TextureName(GetClTextureT(clN)), cTB, 
			GetClUseTexture(clN), cTB, 
			GetClOpacity(clN)
			);
	END; { A_GetClassAttrs_WriteLn }


{ Orso ***************************** } 
{ analizes a class and writes to file. The file must be opened and closed elsewhere }
{ supports custom markers (from VW 13) }
PROCEDURE A_GetClassAttrs_WriteLn2(clN: STRING);
	CONST
		cTB = Chr(9);
		cB = ';';
	VAR
		cl_PF, cl_PB, cl_FF, cl_FB : RGBCOLOR;
		cl_FillN, clBegMark, clEndMark : STRING;
		cl_Mark : LONGINT;
		cl_MarkAng, cl_MarkThickBas : INTEGER;
		cl_MarkSize, cl_MarkWidth, cl_MarkThick : REAL;
		
	BEGIN
		{ RGBToColorIndex(RED, GREEN, BLUE, colorValue); }
		GetClPenFore(clN, cl_PF.RED, cl_PF.GREEN, cl_PF.BLUE);
		GetClPenBack(clN, cl_PB.RED, cl_PB.GREEN, cl_PB.BLUE);
		GetClFillFore(clN, cl_FF.RED, cl_FF.GREEN, cl_FF.BLUE);
		GetClFillBack(clN, cl_FB.RED, cl_FB.GREEN, cl_FB.BLUE);
		
		{ stores eventual fill name, if is bitmap pat, stores the name index }
		IF NOT GetClVectorFill(clN, cl_FillN) THEN
			cl_FillN := Concat(GetClFPat(clN));
		
		{ GetClFPat(clN) = something between 0 and 71, if dash is negative value }
		{ GetClLS(clN) = 0= empty, num= pattern, -num= dash }
		
		{ markers }
		clBegMark := '-';
		clEndMark := '-';
		{GetClassArrow(clN, cl_Mark, cl_MarkSize, cl_MarkAng);}
		IF GetClassBeginningMarker(clN, cl_Mark, cl_MarkAng, cl_MarkSize, cl_MarkWidth, cl_MarkThickBas, cl_MarkThick) THEN
			clBegMark := Concat(cl_Mark, cB, cl_MarkSize, cB, cl_MarkAng, cB, cl_MarkSize, cB, cl_MarkWidth, cB, cl_MarkThickBas, cB, cl_MarkThick, cB);
		IF GetClassEndMarker(clN, cl_Mark, cl_MarkAng, cl_MarkSize, cl_MarkWidth, cl_MarkThickBas, cl_MarkThick) THEN
			clEndMark := Concat(cl_Mark, cB, cl_MarkSize, cB, cl_MarkAng, cB, cl_MarkSize, cB, cl_MarkWidth, cB, cl_MarkThickBas, cB, cl_MarkThick, cB);
			
		WriteLnMac(clN, cTB, 
			cl_PF.RED, cTB, cl_PF.GREEN, cTB, cl_PF.BLUE, cTB, 
			cl_PB.RED, cTB, cl_PB.GREEN, cTB, cl_PB.BLUE, cTB, 
			cl_FF.RED, cTB, cl_FF.GREEN, cTB, cl_FF.BLUE, cTB, 
			cl_FB.RED, cTB, cl_FB.GREEN, cTB, cl_FB.BLUE, cTB, 
			GetObjectVariableInt(GetObject(clN), 696), cTB, cl_FillN, cTB, 
			GetClLS(clN), cTB, GetClLW(clN), cTB, 
			clBegMark, cTB, clEndMark, cTB,
			GetClUseGraphic(clN), cTB, 
			A_TextureName(GetClTextureC(clN)), cTB, A_TextureName(GetClTextureD(clN)), cTB, A_TextureName(GetClTextureG(clN)), cTB, 
			A_TextureName(GetClTextureL(clN)), cTB, A_TextureName(GetClTextureR(clN)), cTB, A_TextureName(GetClTextureT(clN)), cTB, 
			GetClUseTexture(clN), cTB, 
			GetClOpacity(clN)
			);
	END; { A_GetClassAttrs_WriteLn }


Example

Below a standalone script which allows you to export the class list of the current document. This example uses the simpler variant without custom markers support:

{ 
************************************************
06.07.09 Orso. B. Schmid
************************************************
}
 
PROCEDURE xxxxx;
	CONST
		cTB = Chr(9);
	VAR
		filePath : STRING;
		i : INTEGER;
 
	{ Orso ***************************** } 
	{ returns the texture name or '-' if no texture }
	FUNCTION A_TextureName(nameIndx: LONGINT): STRING;
		BEGIN
			A_TextureName := '-';
			IF nameIndx > 0 THEN
				A_TextureName := Index2Name(nameIndx);
		END;
	
	{ Orso ***************************** } 
	{ analizes a class and writes to file. The file must be opened and closed elsewhere }
	PROCEDURE A_GetClassAttrs_WriteLn(clN: STRING);
		CONST
			cTB = Chr(9);
		VAR
			cl_PF, cl_PB, cl_FF, cl_FB : RGBCOLOR;
			cl_FillN : STRING;
			cl_LineMrk, cl_LineMrkAng : INTEGER;
			cl_LineMrkSize : REAL;
			
		BEGIN
			{ RGBToColorIndex(RED, GREEN, BLUE, colorValue); }
			GetClPenFore(clN, cl_PF.RED, cl_PF.GREEN, cl_PF.BLUE);
			GetClPenBack(clN, cl_PB.RED, cl_PB.GREEN, cl_PB.BLUE);
			GetClFillFore(clN, cl_FF.RED, cl_FF.GREEN, cl_FF.BLUE);
			GetClFillBack(clN, cl_FB.RED, cl_FB.GREEN, cl_FB.BLUE);
			
			{ stores eventual fill name, if is bitmap pat, stores the name index }
			IF NOT GetClVectorFill(clN, cl_FillN) THEN
				cl_FillN := Concat(GetClFPat(clN));
			
			{ GetClFPat(clN) = something between 0 and 71, if dash is negative value }
			{ GetClLS(clN) = 0= empty, num= pattern, -num= dash }
			
			GetClassArrow(clN, cl_LineMrk, cl_LineMrkSize, cl_LineMrkAng);
				
			WriteLnMac(clN, cTB, 
				cl_PF.RED, cTB, cl_PF.GREEN, cTB, cl_PF.BLUE, cTB, 
				cl_PB.RED, cTB, cl_PB.GREEN, cTB, cl_PB.BLUE, cTB, 
				cl_FF.RED, cTB, cl_FF.GREEN, cTB, cl_FF.BLUE, cTB, 
				cl_FB.RED, cTB, cl_FB.GREEN, cTB, cl_FB.BLUE, cTB, 
				GetObjectVariableInt(GetObject(clN), 696), cTB, cl_FillN, cTB, 
				GetClLS(clN), cTB, GetClLW(clN), cTB, 
				cl_LineMrk, cTB, cl_LineMrkSize, cTB, cl_LineMrkAng, cTB, 
				GetClUseGraphic(clN), cTB, 
				A_TextureName(GetClTextureC(clN)), cTB, A_TextureName(GetClTextureD(clN)), cTB, A_TextureName(GetClTextureG(clN)), cTB, 
				A_TextureName(GetClTextureL(clN)), cTB, A_TextureName(GetClTextureR(clN)), cTB, A_TextureName(GetClTextureT(clN)), cTB, 
				GetClUseTexture(clN), cTB, 
				GetClOpacity(clN)
				);
		END; { A_GetClassAttrs_WriteLn }
	
BEGIN
	IF YNDialog('Export class list?') THEN BEGIN
		PutFile('Name your file (max 32 chars in VW12):', 'ClassList.txt', filePath);
		{ if the file name is longer than 32 chars in VW12, the file generates but won't load with data }
			
		IF NOT DidCancel THEN BEGIN
		
			{ ***** write headers ***** }
			WriteLnMac(Concat(
				'Class', cTB, 
				'PenForeR', cTB, 'PenForeG', cTB, 'PenForeB', cTB, 
				'PenBackR', cTB, 'PenBackG', cTB, 'PenBackB', cTB, 
					
				'FillForeR', cTB, 'FillForeG', cTB, 'FillForeB', cTB, 
				'FillBackR', cTB, 'FillBackG', cTB, 'FillBackB', cTB, 
					
				'FillStyl', cTB, 'FillName', cTB, 
				
				'LineStyl', cTB, 'LineWeigh', cTB, 
				'LineMark', cTB, 'MarkSize', cTB, 'MarkAng', cTB, 
				'UseCreat', cTB, 
					
				'Txtr_C', cTB, 'Txtr_D', cTB, 'Txtr_G', cTB, 
				'Txtr_L', cTB, 'Txtr_R', cTB, 'Txtr_T', cTB, 
				'TxtrUseCreat', cTB, 'Opac')
			);
			
			{ ***** write class attributes ***** }
			FOR i := 1 TO ClassNum DO
				A_GetClassAttrs_WriteLn(ClassList(i));
		END;
			
		Close(FilePath);
		AlrtDialog('Done');
	END;
END;
Run(xxxxx);