Príklady vytvárania grafických objektov

Príklad nelineárneho získavania farby objektu

Vstupný parameter je index farby logickej palety importovaného súboru. Funkcia vráti index farby z logickej palety používanej v systéme D2000.

function OutputColor(x:integer) return integer is
	c:integer:=Abs(x);
	w:integer:=c mod 10;
	odtien:integer;
begin
	case w is
	when 0 => odtien := 4;
	when 1 => odtien := 2;
	when 2 => odtien := 5;
	when 3 => odtien := 3;
	when 4 => odtien := 7;
	when 5 => odtien := 8;
	when 6 => odtien := 9;
	when 7 => odtien := 11;
	when 8 => odtien := 14;
	when 9 => odtien := 15;
	when others => odtien := 4;
	end case;
	--
	case c is
	when 0.. 9    => return colorTable1(c);
	when 10.. 39  => return CLR_RED (odtien);
	when 40.. 69  => return CLR_YELLOW (odtien);
	when 70..119  => return CLR_GREEN (odtien);
	when 120..139 => return CLR_CYAN (odtien);
	when 140..189 => return CLR_BLUE (odtien);
	when 190..229 => return CLR_PINK (odtien);
	when 230..249 => return CLR_RED (odtien);<
	when 250..255 => return colorTable2(c);
	when others   => return CLR_BLUE(1);
	end case;
	
end OutputColor;

Objekt typu Čiara

Príklad:

	procedure Create_Line(x1,y1,x2, y2:long_float;color,linestyle,thickness:integer) is
	begin
		CreateObj(cLine);
		--
		Set_float2 (cPosXY, x1, y1);
		Set_float2 (cPosXY, x2, y2);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, thickness);
		--
		ObjAction(closeObject);
	end;

Špeciálny objekt typu Čiara alebo Viacnásobná prerušovaná čiara 

Vytvára sa objekt typu Čiara, ktorý (ak má rovnaké atribúty ako predošlé čiary vytvorené týmto parametrom) sa skombinuje s predošlými čiarami do jedného objektu typu Viacnásobná čiara alebo Viacnásobná prerušovaná čiara. Jedná sa o optimalizačnú funkciu na zmenšenie počtu vytváraných objektov a tým aj zmenšenie priestoru potrebného na uloženie schémy (priveľká schéma sa nedá celá uložiť). Príkladom využitia môže byť šrafovanie objektov vo formáte Autocad-u.

Príklad:

	procedure Create_CombinedLine(x1,y1,x2, y2:long_float; color,linestyle,thickness:integer) is

	begin
		CreateObj(cLineCombined);
		--
		Set_float2 (cPosXY, x1, y1);
		Set_float2 (cPosXY, x2, y2);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, thickness);
	 	--
		ObjAction(closeObject);
	end;

Objekt typu Viacnásobná čiara alebo Mnohouholník

Príklad:

	procedure Create_Polyline( posArr : TLong_Float_Arr; color, linestyle, thickness : integer) is
   	pos : integer := posArr'first;
	begin
    		CreateObj(cPLine);
   		--
   		while pos <= posArr'last-1 loop
    		Set_float2 (cPosXY, posArr(pos), posArr(pos+1));
        	pos:= pos+2;end loop;
    		Set_integer(cLineColorIdx, color);
    		Set_integer(cLineStyle, linestyle);
    		Set_integer(clineWidth, 1);
    		--
    		objAction(closeObject);
	end;

Špeciálny objekt typu Viacnásobná čiara alebo Mnohouholník

Príklad:

	procedure Create_PLineItem( x1, y1, x2 , y2 : long_float; 
			color, linestyle, thickness : integer) is
	begin
		CreateObj(cPLineAdd);
		--
		Set_float2 (cPosXY, x1, y1);
		Set_float2 (cPosXY, x2, y2);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, thickness);
	end;

V predošlom príklade mal objekt typu Viacnásobná čiara pri vytváraní k dispozícii všetky pozičné body. Tento objekt sa líši tým, že poznáme iba dáta jednej z čiar objektu a ani nevieme, či je to prvá čiara. Vytváranie je definované ako pridaj sériu parametrov do vytváraného objektu typu viacnásobná čiara, ak má okrem pozičných ostatné parametre totožné. Ak v čase pridávania nie je vytváraný objekt typu Viacnásobná čiara, tak ho založ podľa parametrov tohto objektu.

Séria jednotlivých čiar má byť ukončená nasledovne:

Ukončenie:

	procedure CLose_PLine is
	begin
		objAction(closeObject);
	end;

Objekt typu Viacnásobná prerušovaná čiara

Príklad:

	procedure Create_Polyline( posArr : TLong_Float_Arr; color, linestyle, thickness : integer) is
		pos : integer := posArr'first;
	begin
		CreateObj(cPLine);
		--
		while pos <= posArr'last-1 loop
			Set_float2 (cPosXY, posArr(pos),posArr(pos+1));
			pos:= pos+2;
		end loop;
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, 1);
		--
		objAction(closeObject);
	end;

Objekt typu Oblúk

Príklad:

	procedure Create_Arc(x,y,radius,stangle,endangle:long_float; color,linestyle,thickness:integer) is
	begin
  	  	CreateObj(cArc);
   		 --
    		Set_float2 (cPosXY, x, y);
    		Set_float (cCircleRadial, radius*gr_scall);
    		Set_float (cCircleAngleRadStart, stangle);
    		Set_float (cCircleAngleRadEnd, endangle);
    		Set_integer(cLineColorIdx, color);
   		Set_integer(cLineStyle, linestyle);
    		Set_integer(clineWidth, thickness);
    		--
   		objAction(closeObject);
	end;

Objekt typu Trojbodový oblúk

Príklad:

	procedure Create_3Arc ( x1,y1,x2,y2,x3,y3:long_float; color, linestyle, thickness : integer) is
	begin
		CreateObj(cBox);
		--
		Set_float2 (cPosXY, x1, y1);
		Set_float2 (cPosXY, x2, y2);
		Set_float2 (cPosXY, x3, y3);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, 1);
		--
		objAction(closeObject);
	end;

Objekt typu Obdĺžnik

Príklad:

	procedure Create_Box ( x1,y1,x2,y2:long_float; color, linestyle, thickness : integer) is
	begin
		CreateObj(cBox);
		--
		Set_float2 (cPosXY, x1, y1);
		Set_float2 (cPosXY, x2, y2);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, 1);
		--
		objAction(closeObject);
	end;

Objekt typu Mnohouholník

Príklad:

	procedure Create_Polygon ( posArr : TLong_Float_Arr; color, linestyle, thickness : integer) is
		pos : integer := posArr'first;
	begin
		CreateObj(cPAngle);
		--
		while pos <= posArr'last-1 loop
			Set_float2 (cPosXY, posArr(pos),posArr(pos+1));
			pos:= pos+2;
		end loop;
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, 1);
		--
		objAction(closeObject);
	end;

Objekt typu Kruh

Príklad:

	procedure Create_Circle(x,y,radius : long_float;color,linestyle,thickness:integer) is
	begin
		CreateObj(cCircle);
		--
		Set_float2 (cPosXY, x, y);
		Set_float   (cCircleRadial, radius*gr_scall);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, thickness);
		--
		objAction(closeObject);
	end;

Objekt typu Kruhová výseč

Príklad:

	procedure Create_PiArc(x,y,radius,stangle,endangle:long_float; color,linestyle,thickness:integer) is
	begin
		CreateObj(cPiArc);
		--
		Set_float2 (cPosXY, x, y);
		Set_float (cCircleRadial, radius*gr_scall);
		Set_float (cCircleAngleRadStart, stangle);
		Set_float (cCircleAngleRadEnd, endangle);
		Set_integer(cLineColorIdx, color);
		Set_integer(cLineStyle, linestyle);
		Set_integer(clineWidth, thickness);
		--
		objAction(closeObject);
	end;

Objekt typu Elipsa

Elipsa daná obdĺžnikom, definovaným dvoma bodmi:

Príklad:

	procedure Create_Elipse ( x1,y1,x2,y2:long_float; color, linestyle, thickness : integer) is
	begin
   		CreateObj(cElipse);
    		--
    		Set_float2 (cPosXY, x1, y1);
    		Set_float2 (cPosXY, x2, y2);
    		Set_integer(cLineColorIdx, color);
    		Set_integer(cLineStyle, linestyle);
    		Set_integer(clineWidth, 1);
    		--
    		objAction(closeObject);
	end;

Objekt typu Text

Text začínajúci na zadanej pozícii.

Príklad:

	procedure  Create_Text (x,y:long_float; color:integer; text_in:string) is
	begin
    		CreateObj(cText);
    		--
    		Set_float2 (cPosXY, x, y);
    		Set_integer(cTextColorIdx, color);
    		Set_string (cTextText, text_in);
    		--
    		objAction(closeObject);
	end;

Objekt typu Skupina objektov

Objekt typu Skupina objektov zlučuje následne vytvorené objekty do jednej skupiny (až do uzatvorenia skupiny). T.j. objekt sa vytvorí, odpamätáva si následne vytvárané objekty a na pokyn closeGroup, resp. closeAll, sa zapíše do zoznamu vytvorených objektov.

	  procedure Create_Group is
	  begin
		CreateObj(cGroup);
	  end; 

Séria jednotlivých čiar má byť ukončená nasledovne.

Ukončenie:

	  procedure CLose_Group is
	  begin
		objAction(closeGroup);
	  end;