unit M2AddonD;

{$WARN SYMBOL_DEPRECATED OFF}

interface

uses
	SysUtils, Windows, ActiveX, Variants, Classes, Menus, Graphics, ComCtrls,
	AClasses, M2Addon;

type
	IM2IDsListImp = class(TInterface, IM2IDsList)
	private
		FList: TStringList;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create;
		destructor Destroy; override;

		{From IM2IDsList}
		function i_GetItem(i: Longint; out anItem: TM2ID): HResult; stdcall;
		function i_GetCount(out aCount: Longint): HResult; stdcall;

		function i_Add(i: Longint; const anItem: TM2ID): HResult; stdcall;
		function i_Change(i: Longint; const anItem: TM2ID): HResult; stdcall;
		function i_Delete(i: Longint): HResult; stdcall;
		function i_Clear: HResult; stdcall;
	end;

	IM2MacroAttrsListImp = class(TInterface, IM2MacroAttrsList)
	private
		FList: TList;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create;
		destructor Destroy; override;

		{From IM2MacroAttrsList}
		function i_GetItem(i: Longint; out anItem: TM2MacroAttrs): HResult; stdcall;
		function i_GetCount(out aCount: Longint): HResult; stdcall;

		function i_Clear: HResult; stdcall;
		function i_Add(i: Longint; const anItem: TM2MacroAttrs): HResult; stdcall;
	end;

	IM2ParamsListImp = class(TInterface, IM2ParamsList)
	private
		FList: TStringList;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create;
		destructor Destroy; override;

		{From IM2ParamsList}
		function i_GetItem(aKey: Longint; out anItem: TM2String): HResult; stdcall;
		function i_Contains(aKey: Longint): HResult; stdcall;

		function i_Clear: HResult; stdcall;
		function i_Add(aKey: Longint; const anItem: TM2String): HResult; stdcall;
	end;

	IM2ContextMacroAttrsListImp = class(TInterface, IM2ContextMacroAttrsList)
	private
		FList: TList;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create;
		destructor Destroy; override;

		{From IM2ContextMacroAttrsList}
		function i_GetItem(i: Longint; out anItem: TM2ContextMacroAttrs): HResult; stdcall;
		function i_GetCount(out aCount: Longint): HResult; stdcall;

		function i_Clear: HResult; stdcall;
		function i_Add(i: Longint; const anItem: TM2ContextMacroAttrs): HResult; stdcall;
	end;

	TM2CustomEditor = class;

	IM2EditorImp = class(TControlledInterface, IM2Editor)
	private
		FEditor: TM2CustomEditor;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create(anEditor: TM2CustomEditor);

		{From IM2Editor}
		function i_GetEditorOptions(out AnOptions: TM2EditorOptions): HResult; stdcall;

		function i_HideDragging: HResult; stdcall;
		function i_ShowDragging(AMouse: TPoint): HResult; stdcall;

		function i_MouseDown(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint): HResult; stdcall;
		function i_MouseMove(AShift: TM2ShiftState; AMouse: TPoint): HResult; stdcall;
		function i_MouseUp(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint): HResult; stdcall;

		function i_KeyDown(AKey: Word; AShift: TM2ShiftState): HResult; stdcall;
		function i_KeyUp(AKey: Word; AShift: TM2ShiftState): HResult; stdcall;

		function i_Timer: HResult; stdcall;
		function i_Notification(AWhat: TM2EditorNotification): HResult; stdcall;

		function i_GetContextMacroList(out AList: IM2ContextMacroAttrsList; AMouse: TPoint): HResult; stdcall;
		function i_ExecuteMacro(ACommand: Longint; const AParams: TM2String): HResult; stdcall;

		function i_Cancel: HResult; stdcall;
		function i_Paint: HResult; stdcall;
	end;

	TM2CustomEditor = class
	private
		FIEditor: IM2EditorImp;
	public
		constructor Create;
		destructor Destroy; override;

		function GetEditorOptions: TM2EditorOptions; virtual;

		procedure HideDragging; virtual;
		procedure ShowDragging(AMouse: TPoint); virtual;

		procedure MouseDown(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint); virtual;
		procedure MouseMove(AShift: TM2ShiftState; AMouse: TPoint); virtual;
		procedure MouseUp(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint); virtual;

		procedure KeyDown(AKey: Word; AShift: TM2ShiftState); virtual;
		procedure KeyUp(AKey: Word; AShift: TM2ShiftState); virtual;

		procedure Timer; virtual;
		procedure Notification(AWhat: TM2EditorNotification); virtual;

		function GetContextMacroList(AMouse: TPoint): IM2ContextMacroAttrsList; virtual;
		procedure ExecuteMacro(ACommand: Longint; const AParams: TM2String); virtual;

		procedure Cancel; virtual;
		procedure Paint; virtual;

		property IEditor: IM2EditorImp read FIEditor;
	end;

	TM2CustomCallback = class;

	IM2CallbackImp = class(TControlledInterface, IM2Callback)
	private
		FCallback: TM2CustomCallback;

		function SetException(const aMsg: string): HResult;
	public
		constructor Create(aCallback: TM2CustomCallback);

		{From IM2Callback}
		function i_Callback(aPurpose: TM2CallbackPurpose; aValue: Longint): HResult; stdcall;
	end;

	TM2CustomCallback = class
	private
		FICallback: IM2CallbackImp;
	public
		constructor Create;
		destructor Destroy; override;

		function Callback(aPurpose: TM2CallbackPurpose; aValue: Longint): Boolean; virtual;

		property ICallback: IM2CallbackImp read FICallback;
	end;

	function M2Point(X, Y: Double): TM2Point;
	function M2Rect(X1, Y1, X2, Y2: Double): TM2Rect;
	procedure M2RectAssignPoint(var aR: TM2Rect; const aP: TM2Point);
	function M2PointIsEqual(const aPt1, aPt2: TM2Point): Boolean;
	procedure M2RectInflate(var aR1: TM2Rect; aDx, aDy: double);
	function M2RectIntersectsRect(const aR1, aR2: TM2Rect): Boolean;
	function M2RectContainsRect(const aR1, aR2: TM2Rect): Boolean;
	function M2RectContainsPoint(const aR: TM2Rect; const aP: TM2Point): Boolean;
	procedure M2RectExpand(var aR1: TM2Rect; const aPoint: TM2Point);
	procedure M2RectExpandByRect(var aR1: TM2Rect; const aR2: TM2Rect);

	function M2FontStylesToFontStyles(AStyles: TM2FontStyles): TFontStyles;
	function FontStylesToM2FontStyles(AStyles: TFontStyles): TM2FontStyles;

	procedure FreeM2ObjectData(var aData: TM2ObjectData);
	function M2VariantToVariant(const aValue: TM2Variant): Variant;
	function VariantToM2Variant(const aValue: Variant): TM2Variant;
	procedure M2VarInit(var v: TM2Variant);
	procedure M2VarClear(var v: TM2Variant);
	procedure M2VarSetNull(var v: TM2Variant);
	procedure M2VarSetInteger(var v: TM2Variant; aValue: Longint);
	procedure M2VarSetFloat(var v: TM2Variant; aValue: double);
	procedure M2VarSetCurrency(var v: TM2Variant; aValue: Currency);
	procedure M2VarSetDate(var v: TM2Variant; aValue: TDateTime);
	procedure M2VarSetError(var v: TM2Variant; aValue: LongWord);
	procedure M2VarSetBool(var v: TM2Variant; aValue: Boolean);
	procedure M2VarSetString(var v: TM2Variant; const aValue: string);
	procedure M2VarCopy(var aDst: TM2Variant; const aSrc: TM2Variant);
	function M2VarIsMissing(const v: TM2Variant): Boolean;
	function M2VarHasNoNullValue(const v: TM2Variant): Boolean;

	function M2NoneCommand: TM2ContourCommand;
	function M2MoveToCommand(const APoint: TM2Point): TM2ContourCommand;
	function M2LineToCommand(const APoint: TM2Point): TM2ContourCommand;
	function M2ArcToCommand(const APoint: TM2Point; AConvexity: Double): TM2ContourCommand;
	function M2CloseByLineCommand: TM2ContourCommand;
	function M2CloseByArcCommand(AConvexity: Double): TM2ContourCommand;

	procedure FillProjectStructureTreeView(const aManager: TM2AddOnManager;
			aTV: TTreeView; anIncludeStyles: Boolean);

const
	kNoInterfaceErr = 'Неизвестный интерфейс';
	NullM2Rect: TM2Rect = (X1: 0; Y1: 0; X2: 0; Y2: 0);
	NullM2Point: TM2Point = (X: 0; Y: 0);

implementation


{ IM2IDsListImp }

constructor IM2IDsListImp.Create;
begin
	inherited Create;
	FList := TStringList.Create;
end;

destructor IM2IDsListImp.Destroy;
begin
	FList.Free;
	inherited Destroy;
end;

function IM2IDsListImp.i_GetItem(i: Longint; out anItem: TM2ID): HResult;
begin
	try
		anItem := FList[i];
		Result := S_OK;
	except
		on e: Exception do begin
			anItem := kNoID;
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2IDsListImp.i_GetCount(out aCount: Longint): HResult;
begin
	try
		aCount := FList.Count;
		Result := S_OK;
	except
		on e: Exception do begin
			aCount := 0;
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2IDsListImp.i_Add(i: Longint; const anItem: TM2ID): HResult;
begin
	try
		if i < 0 then
			FList.Add(anItem)
		else
			FList.Insert(i, anItem);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2IDsListImp.i_Change(i: Longint; const anItem: TM2ID): HResult;
begin
	try
		FList[i] := anItem;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2IDsListImp.i_Delete(i: Longint): HResult;
begin
	try
		FList.Delete(i);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2IDsListImp.i_Clear: HResult;
begin
	try
		FList.Clear;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2IDsListImp.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, 'Список идентификаторов');
end;

{IM2MacroAttrsListImp }

constructor IM2MacroAttrsListImp.Create;
begin
	inherited Create;
	FList := TList.Create;
end;

destructor IM2MacroAttrsListImp.Destroy;
begin
	i_Clear;
	FList.Free;
	inherited Destroy;
end;

function IM2MacroAttrsListImp.i_GetItem(i: Longint; out anItem: TM2MacroAttrs): HResult;
begin
	try
		anItem := PM2MacroAttrs(FList[i])^;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2MacroAttrsListImp.i_GetCount(out aCount: Longint): HResult;
begin
	try
		aCount := FList.Count;
		Result := S_OK;
	except
		on e: Exception do begin
			aCount := 0;
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2MacroAttrsListImp.i_Clear: HResult;
var
	i: Integer;
	anAttrs: PM2MacroAttrs;
begin
	try
		if Assigned(FList) then begin
			for i := FList.Count-1 downto 0 do begin
				anAttrs := FList[i];
				FList.Delete(i);
				Dispose(anAttrs);
			end;
		end;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2MacroAttrsListImp.i_Add(i: Longint; const anItem: TM2MacroAttrs): HResult;
var
	anAttrs: PM2MacroAttrs;
begin
	try
		New(anAttrs);
		anAttrs^ := anItem;
		if i < 0 then
			FList.Add(anAttrs)
		else
			FList.Insert(i, anAttrs);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2MacroAttrsListImp.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, 'Список макросов');
end;

{ IM2ParamsListImp }

constructor IM2ParamsListImp.Create;
begin
	inherited Create;
	FList := TStringList.Create;
end;

destructor IM2ParamsListImp.Destroy;
begin
	i_Clear;
	FList.Free;
	inherited Destroy;
end;

function IM2ParamsListImp.i_GetItem(aKey: Longint; out anItem: TM2String): HResult;
var
	i: Integer;
begin
	try
		i := FList.IndexOfObject(TObject(aKey));
		if i < 0 then
			raise Exception.Create('Не найден параметр списка');
		anItem := FList[i];
		Result := S_OK;
	except
		on e: Exception do begin
			anItem := '';
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2ParamsListImp.i_Contains(aKey: Longint): HResult;
begin
	try
		if FList.IndexOfObject(TObject(aKey)) < 0 then
			Result := S_FALSE
		else
			Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ParamsListImp.i_Clear: HResult;
begin
	try
		if Assigned(FList) then
			FList.Clear;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ParamsListImp.i_Add(aKey: Longint; const anItem: TM2String): HResult;
begin
	try
		FList.AddObject(anItem, TObject(aKey));
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ParamsListImp.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, 'Список параметров');
end;

{IM2ContextMacroAttrsListImp }

constructor IM2ContextMacroAttrsListImp.Create;
begin
	inherited Create;
	FList := TList.Create;
end;

destructor IM2ContextMacroAttrsListImp.Destroy;
begin
	i_Clear;
	FList.Free;
	inherited Destroy;
end;

function IM2ContextMacroAttrsListImp.i_GetItem(i: Longint; out anItem: TM2ContextMacroAttrs): HResult;
begin
	try
		anItem := PM2ContextMacroAttrs(FList[i])^;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ContextMacroAttrsListImp.i_GetCount(out aCount: Longint): HResult;
begin
	try
		aCount := FList.Count;
		Result := S_OK;
	except
		on e: Exception do begin
			aCount := 0;
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2ContextMacroAttrsListImp.i_Clear: HResult;
var
	i: Integer;
	anAttrs: PM2ContextMacroAttrs;
begin
	try
		if Assigned(FList) then begin
			for i := FList.Count-1 downto 0 do begin
				anAttrs := FList[i];
				FList.Delete(i);
				Dispose(anAttrs);
			end;
		end;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ContextMacroAttrsListImp.i_Add(i: Longint; const anItem: TM2ContextMacroAttrs): HResult;
var
	anAttrs: PM2ContextMacroAttrs;
begin
	try
		New(anAttrs);
		anAttrs^ := anItem;
		if i < 0 then
			FList.Add(anAttrs)
		else
			FList.Insert(i, anAttrs);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2ContextMacroAttrsListImp.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, 'Список контекстных макросов');
end;

{ IM2EditorImp }

constructor IM2EditorImp.Create(anEditor: TM2CustomEditor);
begin
	inherited Create(anEditor);
	FEditor := anEditor;
end;

function IM2EditorImp.i_GetEditorOptions(out AnOptions: TM2EditorOptions): HResult;
begin
	try
		AnOptions := FEditor.GetEditorOptions;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_HideDragging: HResult;
begin
	try
		FEditor.HideDragging;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_ShowDragging(AMouse: TPoint): HResult;
begin
	try
		FEditor.ShowDragging(AMouse);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_MouseDown(AButton: TM2MouseButton; AShift: TM2ShiftState;
		AMouse: TPoint): HResult;
begin
	try
		FEditor.MouseDown(AButton, AShift, AMouse);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_MouseMove(AShift: TM2ShiftState; AMouse: TPoint): HResult;
begin
	try
		FEditor.MouseMove(AShift, AMouse);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_MouseUp(AButton: TM2MouseButton; AShift: TM2ShiftState;
		AMouse: TPoint): HResult;
begin
	try
		FEditor.MouseUp(AButton, AShift, AMouse);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_KeyDown(AKey: Word; AShift: TM2ShiftState): HResult;
begin
	try
		FEditor.KeyDown(AKey, AShift);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_KeyUp(AKey: Word; AShift: TM2ShiftState): HResult;
begin
	try
		FEditor.KeyUp(AKey, AShift);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_Timer: HResult;
begin
	try
		FEditor.Timer;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_Notification(AWhat: TM2EditorNotification): HResult;
begin
	try
		FEditor.Notification(AWhat);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_GetContextMacroList(out AList: IM2ContextMacroAttrsList;
		AMouse: TPoint): HResult;
begin
	try
		AList := FEditor.GetContextMacroList(AMouse);
		Result := S_OK;
	except
		on e: Exception do begin
			AList := nil;
			Result := SetException(e.Message);
		end;
	end;
end;

function IM2EditorImp.i_ExecuteMacro(ACommand: Longint; const AParams: TM2String): HResult;
begin
	try
		FEditor.ExecuteMacro(ACommand, AParams);
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_Cancel: HResult;
begin
	try
		FEditor.Cancel;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.i_Paint: HResult;
begin
	try
		FEditor.Paint;
		Result := S_OK;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2EditorImp.SetException(const AMsg: string): HResult;
begin
	Result := RaiseM2Exception(AMsg, 'Редактор карты');
end;

{ TM2CustomEditor }

constructor TM2CustomEditor.Create;
begin
	inherited Create;
	FIEditor := IM2EditorImp.Create(Self);
	FIEditor._AddRef;
end;

destructor TM2CustomEditor.Destroy;
begin
	FIEditor.Free;
	inherited Destroy;
end;

function TM2CustomEditor.GetEditorOptions: TM2EditorOptions;
begin
	Result := eopProcessPhase;
end;

procedure TM2CustomEditor.HideDragging;
begin
end;

procedure TM2CustomEditor.ShowDragging(AMouse: TPoint);
begin
end;

procedure TM2CustomEditor.MouseDown(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint);
begin
end;

procedure TM2CustomEditor.MouseMove(AShift: TM2ShiftState; AMouse: TPoint);
begin
end;

procedure TM2CustomEditor.MouseUp(AButton: TM2MouseButton; AShift: TM2ShiftState; AMouse: TPoint);
begin
end;

procedure TM2CustomEditor.KeyDown(AKey: Word; AShift: TM2ShiftState);
begin
end;

procedure TM2CustomEditor.KeyUp(AKey: Word; AShift: TM2ShiftState);
begin
end;

procedure TM2CustomEditor.Timer;
begin
end;

procedure TM2CustomEditor.Notification(AWhat: TM2EditorNotification);
begin
end;

function TM2CustomEditor.GetContextMacroList(AMouse: TPoint): IM2ContextMacroAttrsList;
begin
	Result := IM2ContextMacroAttrsListImp.Create;
end;

procedure TM2CustomEditor.ExecuteMacro(ACommand: Longint; const AParams: TM2String);
begin
end;

procedure TM2CustomEditor.Cancel;
begin
end;

procedure TM2CustomEditor.Paint;
begin
end;

{ IM2CallbackImp }

constructor IM2CallbackImp.Create(aCallback: TM2CustomCallback);
begin
	inherited Create(aCallback);
	FCallback := aCallback;
end;

function IM2CallbackImp.i_Callback(aPurpose: TM2CallbackPurpose; aValue: Longint): HResult;
begin
	try
		if FCallback.Callback(aPurpose, aValue) then
			Result := S_OK
		else
			Result := S_FALSE;
	except
		on e: Exception do
			Result := SetException(e.Message);
	end;
end;

function IM2CallbackImp.SetException(const aMsg: string): HResult;
begin
	Result := RaiseM2Exception(aMsg, 'Интерфейс обратного вызова');
end;

{ TM2CustomCallback }

constructor TM2CustomCallback.Create;
begin
	inherited Create;
	FICallback := IM2CallbackImp.Create(Self);
	FICallback._AddRef;
end;

destructor TM2CustomCallback.Destroy;
begin
	FICallback.Free;
	inherited Destroy;
end;

function TM2CustomCallback.Callback(aPurpose: TM2CallbackPurpose; aValue: Longint): Boolean;
begin
	Result := True;
end;


function M2Point(X, Y: Double): TM2Point;
begin
	Result.X := X;
	Result.Y := Y;
end;

function M2Rect(X1, Y1, X2, Y2: Double): TM2Rect;
begin
	Result.X1 := X1;
	Result.Y1 := Y1;
	Result.X2 := X2;
	Result.Y2 := Y2;
end;

procedure M2RectAssignPoint(var aR: TM2Rect; const aP: TM2Point);
begin
	with aR do begin
		X1 := aP.X;
		X2 := aP.X;
		Y1 := aP.Y;
		Y2 := aP.Y;
	end;
end;

function M2PointIsEqual(const aPt1, aPt2: TM2Point): Boolean;
begin
	Result := (aPt1.x = aPt2.x) and (aPt1.y = aPt2.y);
end;

procedure M2RectInflate(var aR1: TM2Rect; aDx, aDy: double);
begin
	with aR1 do begin
		x1 := x1 - aDx;
		x2 := x2 + aDx;
		y1 := y1 - aDy;
		y2 := y2 + aDy;
	end;
end;

function M2RectIntersectsRect(const aR1, aR2: TM2Rect): Boolean;
begin
	Result := False;
	with aR1 do begin
		if x1 > aR2.x2 then Exit;
		if y1 > aR2.y2 then Exit;
		if x2 < aR2.x1 then Exit;
		if y2 < aR2.y1 then Exit;
	end;
	Result := True;
end;

function M2RectContainsRect(const aR1, aR2: TM2Rect): Boolean;
begin
	with aR1 do
		Result :=
			(aR2.x1 >= x1) and (aR2.x1 <= x2) and
			(aR2.x2 >= x1) and (aR2.x2 <= x2) and
			(aR2.y1 >= y1) and (aR2.y1 <= y2) and
			(aR2.y2 >= y1) and (aR2.y2 <= y2);
end;

function M2RectContainsPoint(const aR: TM2Rect; const aP: TM2Point): Boolean;
begin
	with aP do
		Result := (X > aR.X1) and (X < aR.X2) and (Y > aR.Y1) and (Y < aR.Y2);
end;

procedure M2RectExpand(var aR1: TM2Rect; const aPoint: TM2Point);
begin
	with aR1 do begin
		if aPoint.x < x1 then x1 := aPoint.x;
		if aPoint.x > x2 then x2 := aPoint.x;
		if aPoint.y < y1 then y1 := aPoint.y;
		if aPoint.y > y2 then y2 := aPoint.y;
	end;
end;

procedure M2RectExpandByRect(var aR1: TM2Rect; const aR2: TM2Rect);
begin
	with aR1 do begin
		if aR2.x1 < x1 then x1 := aR2.x1;
		if aR2.x2 > x2 then x2 := aR2.x2;
		if aR2.y1 < y1 then y1 := aR2.y1;
		if aR2.y2 > y2 then y2 := aR2.y2;
	end;
end;

function M2FontStylesToFontStyles(AStyles: TM2FontStyles): TFontStyles;
begin
	Result := [];
	if (kfsBold and AStyles) <> 0 then
		Include(Result, fsBold);
	if (kfsItalic and AStyles) <> 0 then
		Include(Result, fsItalic);
	if (kfsUnderline and AStyles) <> 0 then
		Include(Result, fsUnderline);
	if (kfsStrikeOut and AStyles) <> 0 then
		Include(Result, fsStrikeOut);
end;

function FontStylesToM2FontStyles(AStyles: TFontStyles): TM2FontStyles;
begin
	Result := kfsPlane;
	if fsBold in AStyles then
		Result := Result or kfsBold;
	if fsItalic in AStyles then
		Result := Result or kfsItalic;
	if fsUnderline in AStyles then
		Result := Result or kfsUnderline;
	if fsStrikeOut in AStyles then
		Result := Result or kfsStrikeOut;
end;


procedure FreeM2ObjectData(var aData: TM2ObjectData);
var
	aTableData: PM2TableData;
	v: PM2Variant;
	i, j: Integer;
begin
	if aData.Data = nil then
		exit;
	aTableData := aData.Data;
	for i := 0 to aData.Count-1 do begin
		v := aTableData.FieldNames;
		if v <> nil then begin
			for j := 0 to aTableData.FieldCount-1 do begin
				M2VarClear(v^);
				Inc(v);
			end;
			CoTaskMemFree(aTableData.FieldNames);
		end;

		v := aTableData.Data;
		if v <> nil then begin
			for j := 0 to aTableData.ElemCount-1 do begin
				M2VarClear(v^);
				Inc(v);
			end;
			CoTaskMemFree(aTableData.Data);
		end;

		Inc(aTableData);
	end;
	CoTaskMemFree(aData.Data);
	aData.Data := nil;
	aData.Count := 0;
end;

function M2VariantToVariant(const aValue: TM2Variant): Variant;
begin
	Result := Unassigned;
	with TVarData(Result) do begin
		case aValue.vt of
			VT_EMPTY:
				VType := VT_EMPTY;
			VT_NULL:
				VType := VT_NULL;
			VT_I4: begin
				VInteger := aValue.lVal;
				VType := VT_I4;
			end;
			VT_R8: begin
				VDouble := aValue.dblVal;
				VType := VT_R8;
			end;
			VT_CY: begin
				VCurrency := aValue.cyVal;
				VType := VT_CY;
			end;
			VT_DATE: begin
				VDate := aValue.dateVal;
				VType := VT_DATE;
			end;
			VT_ERROR: begin
				VError := aValue.scode;
				VType := VT_ERROR;
			end;
			VT_BOOL: begin
				VBoolean := aValue.boolVal;
				VType := VT_BOOL;
			end;
			VT_LPSTR:
				Result := string(aValue.strVal);
			else
				raise Exception.Create('Неизвестный тип переменной типа M2Variant');
		end;
	end;
end;

function VariantToM2Variant(const aValue: Variant): TM2Variant;
begin
	Result.vt := VT_EMPTY;
	with TVarData(aValue) do begin
		case VType of
			VT_EMPTY:
				Result.vt := VT_EMPTY;
			VT_NULL:
				Result.vt := VT_NULL;
			VT_I2, VT_I4: begin
				Result.lVal := aValue;
				Result.vt := VT_I4;
			end;
			VT_R4, VT_R8: begin
				Result.dblVal := aValue;
				Result.vt := VT_R8;
			end;
			VT_CY: begin
				Result.cyVal := VCurrency;
				Result.vt := VT_CY;
			end;
			VT_DATE: begin
				Result.dateVal := VDate;
				Result.vt := VT_DATE;
			end;
			VT_ERROR: begin
				Result.scode := VError;
				Result.vt := VT_ERROR;
			end;
			VT_BOOL: begin
				Result.boolVal := VBoolean;
				Result.vt := VT_BOOL;
			end;
			VT_BSTR, VT_LPSTR, varString: begin
				Result.strVal := StrNew(PChar(string(aValue)));
				Result.vt := VT_LPSTR;
			end
			else
				raise Exception.Create('Неизвестный тип переменной типа Variant');
		end;
	end;
end;

procedure M2VarInit(var v: TM2Variant);
begin
	v.vt := VT_EMPTY;
end;

procedure M2VarClear(var v: TM2Variant);
begin
	if v.vt = VT_LPSTR then
		StrDispose(v.strVal);
	v.vt := VT_EMPTY;
end;

procedure M2VarSetNull(var v: TM2Variant);
begin
	M2VarClear(v);
	v.vt := VT_NULL;
end;

procedure M2VarSetInteger(var v: TM2Variant; aValue: Longint);
begin
	M2VarClear(v);
	v.lVal := aValue;
	v.vt := VT_I4;
end;

procedure M2VarSetFloat(var v: TM2Variant; aValue: double);
begin
	M2VarClear(v);
	v.dblVal := aValue;
	v.vt := VT_R8;
end;

procedure M2VarSetCurrency(var v: TM2Variant; aValue: Currency);
begin
	M2VarClear(v);
	v.cyVal := aValue;
	v.vt := VT_CY;
end;

procedure M2VarSetDate(var v: TM2Variant; aValue: TDateTime);
begin
	M2VarClear(v);
	v.dateVal := aValue;
	v.vt := VT_DATE;
end;

procedure M2VarSetError(var v: TM2Variant; aValue: LongWord);
begin
	M2VarClear(v);
	v.scode := aValue;
	v.vt := VT_ERROR;
end;

procedure M2VarSetBool(var v: TM2Variant; aValue: Boolean);
begin
	M2VarClear(v);
	v.boolVal := aValue;
	v.vt := VT_BOOL;
end;

procedure M2VarSetString(var v: TM2Variant; const aValue: string);
begin
	M2VarClear(v);
	v.strVal := StrNew(PChar(aValue));
	v.vt := VT_LPSTR;
end;

procedure M2VarCopy(var aDst: TM2Variant; const aSrc: TM2Variant);
begin
	M2VarClear(aDst);
	if aSrc.vt = VT_LPSTR then begin
		aDst.strVal := StrNew(aSrc.strVal);
		aDst.vt := VT_LPSTR;
	end
	else
		aDst := aSrc;
end;

function M2VarIsMissing(const v: TM2Variant): Boolean;
begin
	Result := (v.vt = VT_ERROR);
	Result := Result and
		(v.scode = DISP_E_PARAMNOTFOUND);
end;

function M2VarHasNoNullValue(const v: TM2Variant): Boolean;
begin
	Result := (v.vt <> VT_ERROR) and (v.vt <> VT_EMPTY) and (v.vt <> VT_NULL);
end;

function M2NoneCommand: TM2ContourCommand;
begin
	Result.CommandType := ccNone;
end;

function M2MoveToCommand(const APoint: TM2Point): TM2ContourCommand;
begin
	Result.CommandType := ccMoveTo;
	Result.MoveTo.Point := APoint;
end;

function M2LineToCommand(const APoint: TM2Point): TM2ContourCommand;
begin
	Result.CommandType := ccLineTo;
	Result.LineTo.Point := APoint;
end;

function M2ArcToCommand(const APoint: TM2Point; AConvexity: Double): TM2ContourCommand;
begin
	Result.CommandType := ccArcTo;
	Result.ArcTo.Point := APoint;
	Result.ArcTo.Convexity := AConvexity;
end;

function M2CloseByLineCommand: TM2ContourCommand;
begin
	Result.CommandType := ccCloseByLine;
end;

function M2CloseByArcCommand(AConvexity: Double): TM2ContourCommand;
begin
	Result.CommandType := ccCloseByArc;
	Result.CloseByArc.Convexity := AConvexity;
end;

procedure FillProjectStructureTreeView(const aManager: TM2AddOnManager;
		aTV: TTreeView; anIncludeStyles: Boolean);
var
	aMapProject: TM2MapProject;
	aGISDatabase: TM2GISDatabase;
	aMaps, aLayers, aStyles: TM2IDsList;
	aStyle: TM2Style;

	aMapID, aLayerID, aStyleID: TM2ID;
	aMapAttrs: TM2MapAttrs;
	aLayerAttrs: TM2LayerAttrs;
	aStyleAttrs: TM2StyleAttrs;
	aMapNode, aLayerNode: TTreeNode;
	i, j, k: Integer;
begin
	aTV.Items.BeginUpdate;
	try
		aTV.Items.Clear;

		aMapProject.OleObject := aManager.OleObject as IM2MapProject;
		aGISDatabase.OleObject := aManager.OleObject as IM2GISDatabase;

		aMaps.OleObject := aMapProject.GetMapList;
		for i := 0 to aMaps.Count-1 do begin
			aMapID := aMaps.Items(i);
			aGISDatabase.GetMapAttrs(aMapID, aMapAttrs);
			aMapNode := aTV.Items.AddChildObject(nil, aMapAttrs.Name, NewStr(aMapID));

			aLayers.OleObject := aMapProject.GetLayerList(aMapID);
			for j := 0 to aLayers.Count-1 do begin
				aLayerID := aLayers.Items(j);
				aGISDatabase.GetLayerAttrs(aLayerID, aLayerAttrs);
				aLayerNode := aTV.Items.AddChildObject(aMapNode, aLayerAttrs.Name, NewStr(aLayerID));

				if anIncludeStyles then begin
					aStyles.OleObject := aGISDatabase.GetStyleList(aLayerID);
					for k := 0 to aStyles.Count-1 do begin
						aStyleID := aStyles.Items(k);
						aStyle.OleObject := aGISDatabase.GetStyle(aStyleID);
						aStyle.GetAttrs(aStyleAttrs);
						aTV.Items.AddChildObject(aLayerNode, aStyleAttrs.Name, NewStr(aStyleID));
					end;
				end;
			end;
		end;
	finally
		aTV.Items.EndUpdate;
	end;
end;

end.
