unit AddOnUtils;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	ComCtrls, StdCtrls, CommCtrl, ExtCtrls, M2AddOn, M2AddOnD, DllForm,
	M2AddonImp, XLists, ImgList, Geomet, Complex, SelectInTreeView, Menus;

type
	TM2SysObjectType = (otMap, otLayer, otStyle, otSemTable);
	TM2SysObject = class
		ObjectType: TM2SysObjectType;
		ID: TM2ID;
		Name: String;
		constructor Create(anObjectType: TM2SysObjectType; const anID: TM2ID;
			const aName: String);
	end;

	TLoadMaps = (lmVect, lmRaster, lmAll);
	TLoadStyles = (lsWithTextPainters, lsAll);
	TM2SysObjectList = class(TObjectList)
	private
		FAddon: TM2CustomAddon;
		function GetItem(anIndex: Integer): TM2SysObject;
	public
		procedure LoadMaps(anAreaID: TM2ID; aLoadMaps: TLoadMaps);
		procedure LoadLayers(aMapID: TM2ID);
		procedure LoadStyles(aLayerID: TM2ID; aLoadStyles: TLoadStyles);
		procedure LoadSemTables(aLayerID: TM2ID);
		procedure FillStrings(aStrings: TStrings);

		property Items[anIndex: Integer]: TM2SysObject read GetItem; default;
		property Addon: TM2CustomAddon read FAddon write FAddon;
	end;

	TIDHolderKind = (idMap, idLayer, idStyle);
	TIDHolder = class
		ID: TM2ID;
		Kind: TIDHolderKind;

		constructor Create(const anID: TM2ID; aKind: TIDHolderKind);
		constructor CreateCopy(aSrc: TIDHolder);
	end;

	TIDHolderList = class(TList)
	private
		function GetItem(anIndex: Integer): TIDHolder;
	public
		property Items[anIndex: Integer]: TIDHolder read GetItem; default;
		destructor Destroy; override;
		function IndexOfID(const anID: TM2ID): Integer;
	end;

	TProjectTreeForm = class(TDllForm)
		ProjectTree: TTreeView;
		ImageList: TImageList;
		TreeLabel: TLabel;
		OkButton: TButton;
		CancelButton: TButton;
		PopupMenu: TPopupMenu;
		FindItem: TMenuItem;
		procedure FormCreate(Sender: TObject);
		procedure ProjectTreeMouseMove(Sender: TObject; Shift: TShiftState; X,
			Y: Integer);
		procedure ProjectTreeMouseDown(Sender: TObject; Button: TMouseButton;
			Shift: TShiftState; X, Y: Integer);
		procedure ProjectTreeChange(Sender: TObject; Node: TTreeNode);
		procedure ProjectTreeDblClick(Sender: TObject);
		procedure FindItemClick(Sender: TObject);
	private
		Kind: TIDHolderKind;
		MultiSelect: Boolean;
		{ Private declarations }
	public
		procedure SetData(anAddOn: TM2CustomAddOn; aKind: TIDHolderKind; aSelected: TIDHolderList);
		function GetData(aSelected: TIDHolderList): Boolean;

		procedure SelectID(const anID: TM2ID);
		function GetSelectedID: TM2ID;
	end;

function LayerIDFromStyleID(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): TM2ID;
function MapIDFromStyleID(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): TM2ID;
function MapIDFromLayerID(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID): TM2ID;

function GetMapCaption(anAddOn: TM2CustomAddOn; const aMapID: TM2ID;
	const aDefault: String): String;
function GetLayerCaption(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID;
	const aDefault: String): String;
function GetStyleCaption(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID;
	const aDefault: String): String;

function LayerExists(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID): Boolean;
function StyleExists(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): Boolean;

function RectToStr(const aRect: TRect): string;
function StrToRect(const s: string; const aDef: TRect): TRect;

type
	TStreamProc = procedure(aStm: TStream) of object;

function CompareByStream(aSave1, aSave2: TStreamProc): Integer;

type
	TInitListItem = procedure(aListItem: TListItem);

procedure UpdateListView(aListView: TListView; aDataList: TList; aFocusedData: TObject;
	anInitListItem: TInitListItem; aSelectFocused: Boolean);

type
	TLoadObjectFromStream = function(aStm: TStream): TObject;
	TSaveObjectToStream = procedure(aStm: TStream; anObject: TObject);
	TLoadObjectFromPrefs = function(aPrefs: IM2Preferences; const aPrefix: String): TObject;
	TSaveObjectToPrefs = procedure(aPrefs: IM2Preferences; const aPrefix: String; anObject: TObject);

procedure LoadObjectListFromStream(aStm: TStream; aList: TList; aLoad: TLoadObjectFromStream);
procedure SaveObjectListToStream(aStm: TStream; aList: TList; aSave: TSaveObjectToStream);

function SelectIDList(anAddOn: TM2CustomAddOn; const aCaption: String; aKind: TIDHolderKind;
	aSelected: TIDHolderList): Boolean;
function SelectID(anAddOn: TM2CustomAddOn; const aCaption: String; aKind: TIDHolderKind;
	var aSelected: TM2ID): Boolean;

function LoadIDFromStream(aStm: TStream): TM2ID;
procedure SaveIDToStream(aStm: TStream; const anID: TM2ID);

function M2PointToDPoint(const aPoint: TM2Point): TDPoint;
function DPointToM2Point(const aPoint: TDPoint): TM2Point;
function M2RectToDRect(const aRect: TM2Rect): TDRect;
function DRectToM2Rect(const aRect: TDRect): TM2Rect;
function M2CommandToCommand(const aM2Command: TM2ContourCommand): TContourCommand;
function CommandToM2Command(const aCommand: TContourCommand): TM2ContourCommand;
function CreateContourFromM2Contour(const aM2Contour: IM2Contour): TContour;
function IsIDOrSimID(const s: String): Boolean;
function IsSimID(const s: String): Boolean;


implementation

{$R *.DFM}

uses
	Cursors, GisResources, InSysUtils, GraphicUtils, AClasses;

function RectToStr(const aRect: TRect): string;
begin
	with aRect do
		Result := Format('%d %d %d %d', [Left, Top, Right, Bottom]);
end;

function StrToRect(const s: string; const aDef: TRect): TRect;
var
	aScan: TStrScan;

	function FetchValue(aDef: Integer): Integer;
	begin
		if aScan.FetchNumbers then
			Result := StrToInt(aScan.Token)
		else
			Result := aDef;
	end;

begin
	aScan.Init(s);
	Result.Left := FetchValue(aDef.Left);
	Result.Top := FetchValue(aDef.Top);
	Result.Right := FetchValue(aDef.Right);
	Result.Bottom := FetchValue(aDef.Bottom);
end;

function IsIDOrSimID(const s: String): Boolean;
begin
	Result := (AnsiCompareText(s, 'ID') = 0) or (AnsiCompareText(s, 'SIMID') = 0);
end;

function IsSimID(const s: String): Boolean;
begin
	Result := AnsiCompareText(s, 'SIMID') = 0;
end;

function LoadIDFromStream(aStm: TStream): TM2ID;
begin
	Result := LoadIDFromStream(aStm);
end;

procedure SaveIDToStream(aStm: TStream; const anID: TM2ID);
begin
	SaveIDToStream(aStm, anID);
end;

function GetMapCaption(anAddOn: TM2CustomAddOn; const aMapID: TM2ID;
	const aDefault: String): String;
var
	aMap: TM2MapAttrs;
begin
	try
		anAddOn.GISDatabase.GetMapAttrs(aMapID, aMap);
		Result := aMap.Name;
	except
		Result := aDefault
	end
end;

function LayerIDFromStyleID(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): TM2ID;
var
	aStyle: TM2Style;
	aLayers: TM2IDsList;
begin
	try
		aStyle.OleObject := anAddOn.GISDatabase.GetStyle(aStyleID);
		aLayers.OleObject := aStyle.GetLayerList;
		Result := aLayers.Items(0);
	except
		Result := ''
	end;
end;

function MapIDFromStyleID(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): TM2ID;
var
	aLayerID: TM2ID;
	aLayer: TM2LayerAttrs;
begin
	aLayerID := LayerIDFromStyleID(anAddOn, aStyleID);
	if aLayerID = '' then
		Result := ''
	else
		try
			anAddOn.GISDatabase.GetLayerAttrs(aLayerID, aLayer);
			Result := aLayer.MapID;
		except
			Result := '';
		end;
end;

function MapIDFromLayerID(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID): TM2ID;
var
	aLayer: TM2LayerAttrs;
begin
	try
		anAddOn.GISDatabase.GetLayerAttrs(aLayerID, aLayer);
		Result := aLayer.MapID;
	except
		Result := '';
	end;
end;

procedure LoadObjectListFromStream(aStm: TStream; aList: TList; aLoad: TLoadObjectFromStream);
var
	aCount: Longint;
begin
	ClearObjectList(aList);
	aStm.Read(aCount, sizeof(aCount));
	while aCount > 0 do begin
		aList.Add(aLoad(aStm));
		Dec(aCount)
	end;
end;

procedure SaveObjectListToStream(aStm: TStream; aList: TList; aSave: TSaveObjectToStream);
var
	aCount: Longint;
	i: Integer;
begin
	aCount := aList.Count;
	aStm.Write(aCount, sizeof(aCount));
	for i := 0 to aCount - 1 do
		aSave(aStm, aList[i]);
end;

function CompareByStream(aSave1, aSave2: TStreamProc): Integer;
var
	aStm1, aStm2: TMemoryStream;
begin
	aStm1 := TMemoryStream.Create;
	try
		aSave1(aStm1);
		aStm2 := TMemoryStream.Create;
		try
			aSave2(aStm2);
			Result := aStm1.Size - aStm2.Size;
			if Result = 0 then
				Result := CmpBytes(aStm1.Memory, aStm2.Memory, aStm1.Size);
		finally
			aStm2.Free
		end
	finally
		aStm1.Free
	end
end;

procedure UpdateListView(aListView: TListView; aDataList: TList; aFocusedData: TObject;
	anInitListItem: TInitListItem; aSelectFocused: Boolean);
var
	anItem,
	aNewFocused: TListItem;
	i: Integer;
begin
	if (aFocusedData = nil) and (aListView.ItemFocused <> nil) then
		aFocusedData := aListView.ItemFocused.Data;
	with aListView.Items do begin
		BeginUpdate;
		try
			Clear;
			aNewFocused := nil;
			for i := 0 to aDataList.Count - 1 do begin
				anItem := Add;
				anItem.Data := aDataList[i];
				anInitListItem(anItem);
				if anItem.Data = aFocusedData then
					aNewFocused := anItem
			end;
		finally
			EndUpdate
		end
	end;

	if not Assigned(aNewFocused) and (aListView.Items.Count > 0) then
		aNewFocused := aListView.Items[0];

	aListView.ItemFocused := aNewFocused;
	if Assigned(aNewFocused) and aSelectFocused then
		aListView.ItemFocused.Selected := True
end;


function GetStyleCaption(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID; const aDefault: String): String;
var
	aStyle: TM2Style;
	aStyleAttrs: TM2StyleAttrs;
begin
	if aStyleID = '' then begin
		Result := aDefault;
		Exit;
	end;
	try
		aStyle.OleObject := anAddOn.GisDatabase.GetStyle(aStyleID);
		aStyle.GetAttrs(aStyleAttrs);
		Result := aStyleAttrs.Name;
	except
		Result := aDefault
	end;
end;

function GetLayerIDFromStyleID(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): TM2ID;
var
	aStyle: TM2Style;
	aLayers: TM2IDsList;
begin
	try
		aStyle.OleObject := anAddOn.GisDatabase.GetStyle(aStyleID);
		aLayers.OleObject := aStyle.GetLayerList;
			if aLayers.Count > 0 then
				Result := aLayers.Items(0)
			else
				Result := '';
	except
		Result := ''
	end;
end;

//****************************************************************************
//	TM2SysObject
//

constructor TM2SysObject.Create(anObjectType: TM2SysObjectType; const anID: TM2ID;
	const aName: String);
begin
	ObjectType := anObjectType;
	ID := anID;
	Name := aName; 
end;

function TM2SysObjectList.GetItem(anIndex: Integer): TM2SysObject;
begin
	Result := inherited Items[anIndex]
end;

procedure TM2SysObjectList.LoadMaps(anAreaID: TM2ID; aLoadMaps: TLoadMaps);
var
	anIDs: TM2IDsList;
	aProject: TM2ProjectAttrs;
	i: Integer;
	aMap: TM2MapAttrs;
	anID: TM2ID;
begin
	if not Assigned(FAddon) then
		Exit;
	if anAreaID = kNoID then begin
		FAddon.MapProject.GetAttrs(aProject);
		anAreaID := aProject.AreaID
	end;
	anIDs.OleObject := FAddon.GISDatabase.GetMapList(anAreaID);
	for i := 0 to anIDs.Count - 1 do begin
		anID := anIDs.Items(i);
		FAddon.GISDatabase.GetMapAttrs(anID, aMap);
		if (aLoadMaps = lmAll) or
			(aLoadMaps = lmRaster) and (aMap.MapType = kmtRaster) or
			(aLoadMaps = lmVect) and (aMap.MapType = kmtVect)
		then
			Add(TM2SysObject.Create(otMap, anID, aMap.Name));
	end;
end;

procedure TM2SysObjectList.LoadLayers(aMapID: TM2ID);
var
	anIDs: TM2IDsList;
	i: Integer;
	aLayer: TM2LayerAttrs;
	anID: TM2ID;
begin
	if not Assigned(FAddon) then
		Exit;
	anIDs.OleObject := FAddon.GISDatabase.GetLayerList(aMapID);
	for i := 0 to anIDs.Count - 1 do begin
		anID := anIDs.Items(i);
		FAddon.GISDatabase.GetLayerAttrs(anID, aLayer);
		Add(TM2SysObject.Create(otLayer, anID, aLayer.Name));
	end;
end;

procedure TM2SysObjectList.LoadStyles(aLayerID: TM2ID; aLoadStyles: TLoadStyles);
var
	anIDs: TM2IDsList;
	i, j: Integer;
	aStyle: TM2Style;
	aPainter: TM2PainterAttrs;
	aStyleAttrs: TM2StyleAttrs;
	anID: TM2ID;
	aCanAdd: Boolean;
begin
	if not Assigned(FAddon) then
		Exit;
	anIDs.OleObject := FAddon.GISDatabase.GetStyleList(aLayerID);
	for i := 0 to anIDs.Count - 1 do begin
		anID := anIDs.Items(i);
		aStyle.OleObject := FAddon.GISDatabase.GetStyle(anID);
		if aLoadStyles = lsWithTextPainters then begin
			aCanAdd := False;
			for j := 0 to aStyle.PainterCount - 1 do begin
				aStyle.GetPainterAttrs(i, aPainter);
				if aPainter.PainterType = kptText then begin
					aCanAdd := True;
					break
				end
			end;
		end
		else
			aCanAdd := True;
		if aCanAdd then begin
			aStyle.GetAttrs(aStyleAttrs);
			Add(TM2SysObject.Create(otStyle, anID, aStyleAttrs.Name));
		end;
	end;
end;

procedure TM2SysObjectList.LoadSemTables(aLayerID: TM2ID);
var
	anIDs: TM2IDsList;
	i: Integer;
	aTable: TM2TableAttrs;
	anID: TM2ID;
begin
	if not Assigned(FAddon) then
		Exit;
	anIDs.OleObject := FAddon.GISDatabase.GetTableList(aLayerID);
	for i := 0 to anIDs.Count - 1 do begin
		anID := anIDs.Items(i);
		FAddon.GISDatabase.GetTableAttrs(anID, aTable);
		Add(TM2SysObject.Create(otSemTable, anID, aTable.UserTableName));
	end;
end;

procedure TM2SysObjectList.FillStrings(aStrings: TStrings);
var
	i: Integer;
	aSysObject: TM2SysObject;
begin
	aStrings.BeginUpdate;
	try
		for i := 0 to Count - 1 do begin
			aSysObject := inherited Items[i];
			aStrings.AddObject(aSysObject.Name, aSysObject);
		end;
	finally
		aStrings.EndUpdate
	end
end;


function LayerExists(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID): Boolean;
var
	aLayerAttrs: TM2LayerAttrs;
begin
	if aLayerID = '' then
		Result := False
	else 
		try
			anAddOn.GisDatabase.GetLayerAttrs(aLayerID, aLayerAttrs);
			Result := True;
		except
			Result := False
		end;
end;

function StyleExists(anAddOn: TM2CustomAddOn; const aStyleID: TM2ID): Boolean;
var
	aStyle: IM2Style;
begin
	if aStyleID = '' then
		Result := False
	else 
		try
			aStyle := anAddOn.GisDatabase.GetStyle(aStyleID);
			Result := True;
		except
			Result := False
		end;
end;
  
function GetLayerCaption(anAddOn: TM2CustomAddOn; const aLayerID: TM2ID;
	const aDefault: String): String;
var
	aLayerAttrs: TM2LayerAttrs;
	aMapAttrs: TM2MapAttrs;
begin
	if aLayerID = '' then begin
		Result := aDefault;
		Exit;
	end;
	try
		anAddOn.GisDatabase.GetLayerAttrs(aLayerID, aLayerAttrs);
		anAddOn.GisDatabase.GetMapAttrs(aLayerAttrs.MapID, aMapAttrs);
		Result := Format('[%s] %s', [aMapAttrs.Name, aLayerAttrs.Name]);
	except
		Result := aDefault
	end;
end;

constructor TIDHolder.Create(const anID: TM2ID; aKind: TIDHolderKind);
begin
	ID := anID;
	Kind := aKind;
end;

constructor TIDHolder.CreateCopy(aSrc: TIDHolder);
begin
	ID := aSrc.ID;
	Kind := aSrc.Kind;
end;

//	TIDHolderList
destructor TIDHolderList.Destroy;
begin
	ClearObjectList(Self);
	inherited Destroy;
end;

function TIDHolderList.GetItem(anIndex: Integer): TIDHolder;
begin
	Result := inherited Items[anIndex]
end;

function TIDHolderList.IndexOfID(const anID: TM2ID): Integer;
begin
	for Result := 0 to Count - 1 do
		if TIDHolder(inherited Items[Result]).ID = anID then
			Exit;
	Result := -1;
end;

const
	nsUnchecked = 1;
	nsChecked = 2;
	nsIndeterminate = 3;

procedure TProjectTreeForm.FormCreate(Sender: TObject);

	procedure AddResBitmap(aResName: PChar);
	var
		aBitmap: TBitmap;
	begin
		aBitmap := CreateSafeBitmapObject;
		try
			aBitmap.Handle := LoadBitmap(HInstance, aResName);
			ImageList.AddMasked(aBitmap, aBitmap.TransparentColor);
		finally
			FreeSafeBitmapObject(aBitmap);
		end;
	end;

begin
	AddResBitmap('UNCHECKED');
	AddResBitmap('UNCHECKED');
	AddResBitmap('CHECKED');
	AddResBitmap('INDETERMINATE');
end;

procedure TProjectTreeForm.SetData(anAddOn: TM2CustomAddOn; aKind: TIDHolderKind; aSelected: TIDHolderList);

	procedure SetNodeState(aNode: TTreeNode);
	begin
		if aSelected = nil then
			aNode.StateIndex := 0
		else if aSelected.IndexOfID(TIDHolder(aNode.Data).ID) <> -1 then
			aNode.StateIndex := nsChecked
		else
			aNode.StateIndex := nsUnchecked;
	end;

	procedure AddStyle(aLayerNode: TTreeNode; const aStyleID: TM2ID);
	var
		aNode: TTreeNode;
		aStyle: TM2Style;
		aStyleAttrs: TM2StyleAttrs;
	begin
		aStyle.OleObject := anAddOn.GisDatabase.GetStyle(aStyleID);
		aStyle.GetAttrs(aStyleAttrs);
		aNode := ProjectTree.Items.AddChildObject(aLayerNode, aStyleAttrs.Name,
			TIDHolder.Create(aStyleID, idStyle));
		SetNodeState(aNode);
	end;

	procedure AddLayer(aMapNode: TTreeNode; const aLayerID: TM2ID);
	var
		aLayerAttrs: TM2LayerAttrs;
		aNode: TTreeNode;
		aStyles: TM2IDsList;
		i: Integer;
	begin
		anAddOn.GisDatabase.GetLayerAttrs(aLayerID, aLayerAttrs);
		aNode := ProjectTree.Items.AddChildObject(aMapNode, aLayerAttrs.Name,
			TIDHolder.Create(aLayerID, idLayer));
		SetNodeState(aNode);
		if Kind = idStyle then begin
			aStyles.OleObject := anAddOn.GisDatabase.GetStyleList(aLayerID);
			for i := 0 to aStyles.Count - 1 do
				AddStyle(aNode, aStyles.Items(i));
		end;
	end;

	procedure AddMap(aParent: TTreeNode; aMapID: TM2ID);
	var
		aMapAttrs: TM2MapAttrs;
		aNode: TTreeNode;
		aLayers: TM2IDsList;
		i: Integer;
	begin
		anAddOn.GisDatabase.GetMapAttrs(aMapID, aMapAttrs);
		aNode := ProjectTree.Items.AddChildObject(aParent, aMapAttrs.Name,
			TIDHolder.Create(aMapID, idMap));
		SetNodeState(aNode);
		if Kind <> idMap then begin
			aLayers.OleObject := anAddOn.GisDatabase.GetLayerList(aMapID);
			for i := 0 to aLayers.Count - 1 do
				AddLayer(aNode, aLayers.Items(i));
		end;
	end;

const
	Captions: array [TIDHolderKind] of String = ('&Список карт:', '&Список слоев:', '&Список стилей:');	
var
	i: Integer;
	aMaps: TM2IDsList;
begin
	Kind := aKind;
	TreeLabel.Caption := Captions[aKind];
	MultiSelect := (aSelected <> nil);
	ProjectTree.Items.BeginUpdate;
	try
		aMaps.OleObject := anAddOn.MapProject.GetMapList;
		for i := 0 to aMaps.Count - 1 do
			AddMap(nil, aMaps.Items(i));
	finally
		ProjectTree.Items.EndUpdate
	end;
end;

function TProjectTreeForm.GetData(aSelected: TIDHolderList): Boolean;
var
	i: Integer;
	aNewSelected: TIDHolderList;
begin
	if aSelected = nil then
		Result := False
	else begin
		Result := False;
		aNewSelected := TIDHolderList.Create;
		try
			for i := 0 to ProjectTree.Items.Count - 1 do
				with ProjectTree.Items[i] do
					if (StateIndex = nsChecked) and (TIDHolder(Data).Kind = Kind) then
						aNewSelected.Add(TIDHolder.CreateCopy(TIDHolder(Data)));
			//	Remove from aSelected items, not contained in aNewSelected
			i := 0;
			while i < aSelected.Count do
				if aNewSelected.IndexOfID(aSelected[i].ID) = -1 then begin
					Result := True;
					aSelected[i].Free;
					aSelected.Delete(i);
				end
				else
					Inc(i);
			//	Add from aNewSelected, items, not cointained in aSelected
			i := 0;
			while i < aNewSelected.Count do
				if aSelected.IndexOfID(aNewSelected[i].ID) = -1 then begin
					Result := True;
					aSelected.Add(aNewSelected[i]);
					aNewSelected.Delete(i)
				end
				else
					Inc(i);
		finally
			aNewSelected.Free
		end
	end;
end;

procedure TProjectTreeForm.ProjectTreeMouseMove(Sender: TObject;
	Shift: TShiftState; X, Y: Integer);
var
	aHitTests: THitTests;
begin
	aHitTests := ProjectTree.GetHitTestInfoAt(X, Y);
	if htOnStateIcon in aHitTests then
		ProjectTree.Cursor := crHand
	else
		ProjectTree.Cursor := crDefault;
end;

procedure TProjectTreeForm.ProjectTreeMouseDown(Sender: TObject;
	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

	procedure SetNodeState(aNode: TTreeNode; aState: Integer);
	var
		i: Integer;
	begin
		aNode.StateIndex := aState;
		for i := 0 to aNode.Count - 1 do
			SetNodeState(aNode.Item[i], aState);
	end;

var
	aHitTests: THitTests;
	aNode: TTreeNode;
begin
	aHitTests := ProjectTree.GetHitTestInfoAt(X, Y);
	if htOnStateIcon in aHitTests then begin
		aNode := ProjectTree.GetNodeAt(X, Y);
		if aNode <> nil then
			case aNode.StateIndex of
				nsChecked: SetNodeState(aNode, nsUnchecked);
				nsUnchecked: SetNodeState(aNode, nsChecked);
				nsIndeterminate: SetNodeState(aNode, nsChecked);
			end;
	end
end;

procedure TProjectTreeForm.SelectID(const anID: TM2ID);
var
	aNode: TTreeNode;
begin
	if anID = kNoID then
		exit;
	aNode := ProjectTree.Items.GetFirstNode;
	while Assigned(aNode) do begin
		if TIDHolder(aNode.Data).ID = anID then begin
			ProjectTree.Selected := aNode;
			aNode.MakeVisible;
			break;
		end;
		aNode := aNode.GetNext;
	end;
end;

function TProjectTreeForm.GetSelectedID: TM2ID;
begin
	if ProjectTree.Selected = nil then
		Result := ''
	else with TIDHolder(ProjectTree.Selected.Data) do
		if MultiSelect or (Kind = Self.Kind) then
			Result := ID
		else
			Result := '';
end;

procedure TProjectTreeForm.ProjectTreeChange(Sender: TObject;
	Node: TTreeNode);
begin
	OkButton.Enabled := GetSelectedID <> '';
end;

function SelectIDList(anAddOn: TM2CustomAddOn; const aCaption: String; aKind: TIDHolderKind;
	aSelected: TIDHolderList): Boolean;
var
	aForm: TProjectTreeForm;
begin
	aForm := TProjectTreeForm.Create(Application);
	try
		aForm.Caption := aCaption;
		aForm.SetData(anAddOn, aKind, aSelected);
		if aForm.ShowModal = mrOk then
			Result := aForm.GetData(aSelected)
		else
			Result := False;
	finally
		aForm.Free
	end
end;

function SelectID(anAddOn: TM2CustomAddOn; const aCaption: String; aKind: TIDHolderKind;
	var aSelected: TM2ID): Boolean;
var
	aForm: TProjectTreeForm;
	aSaveSelected: TM2ID;
begin
	aForm := TProjectTreeForm.Create(Application);
	try
		aForm.Caption := aCaption;
		aForm.SetData(anAddOn, aKind, nil);
		aForm.SelectID(aSelected);
		if aForm.ShowModal = mrOk then begin
			aSaveSelected := aSelected;
			aSelected := aForm.GetSelectedID;
			Result := aSaveSelected <> aSelected;
		end
		else
			Result := False;
	finally
		aForm.Free
	end
end;

procedure TProjectTreeForm.ProjectTreeDblClick(Sender: TObject);
begin
	if not MultiSelect and OkButton.Enabled then
		ModalResult := mrOk;
end;

function M2PointToDPoint(const aPoint: TM2Point): TDPoint;
begin
	with Result do begin
		x := aPoint.x;
		y := aPoint.y;
	end;
end;

function DPointToM2Point(const aPoint: TDPoint): TM2Point;
begin
	with Result do begin
		x := aPoint.x;
		y := aPoint.y;
	end;
end;

function M2RectToDRect(const aRect: TM2Rect): TDRect;
begin
	with Result do begin
		x1 := aRect.x1;
		x2 := aRect.x2;
		y1 := aRect.y1;
		y2 := aRect.y2;
	end;
end;

function DRectToM2Rect(const aRect: TDRect): TM2Rect;
begin
	with Result do begin
		x1 := aRect.x1;
		x2 := aRect.x2;
		y1 := aRect.y1;
		y2 := aRect.y2;
	end;
end;

function M2CommandToCommand(const aM2Command: TM2ContourCommand): TContourCommand;
begin
	with Result do
		case aM2Command.CommandType of
			ccNone:
				CommandType := ctNone;
			ccMoveTo: begin
				CommandType := ctMoveTo;
				Point := M2PointToDPoint(aM2Command.MoveTo.Point);
			end;
			ccLineTo: begin
				CommandType := ctLineTo;
				Point := M2PointToDPoint(aM2Command.LineTo.Point);
			end;
			ccCloseByLine:
				CommandType := ctCloseByLine;
			ccArcTo: begin
				CommandType := ctArcTo;
				Point := M2PointToDPoint(aM2Command.ArcTo.Point);
				Convexity := aM2Command.ArcTo.Convexity;
			end;
			ccCloseByArc: begin
				CommandType := ctCloseByArc;
				Convexity := aM2Command.CloseByArc.Convexity;
			end;
		end;
end;

function CommandToM2Command(const aCommand: TContourCommand): TM2ContourCommand;
begin
	with Result do
		case aCommand.CommandType of
			ctNone:
				CommandType := ccNone;
			ctMoveTo: begin
				CommandType := ccMoveTo;
				MoveTo.Point := DPointToM2Point(aCommand.Point);
			end;
			ctLineTo: begin
				CommandType := ccLineTo;
				LineTo.Point := DPointToM2Point(aCommand.Point);
			end;
			ctCloseByLine:
				CommandType := ccCloseByLine;
			ctArcTo: begin
				CommandType := ccArcTo;
				ArcTo.Point := DPointToM2Point(aCommand.Point);
				ArcTo.Convexity := aCommand.Convexity;
			end;
			ctCloseByArc: begin
				CommandType := ccCloseByArc;
				CloseByArc.Convexity := aCommand.Convexity;
			end;
		end;
end;

function CreateContourFromM2Contour(const aM2Contour: IM2Contour): TContour;
var
	aContour: TM2Contour;
	aContinue: Boolean;
	aCommand: TM2ContourCommand;
begin
	aContour.OleObject := aM2Contour;
	Result := TContour.Create;
	try
		aContinue := aContour.GetFirstCommand(aCommand);
		while aContinue do begin
			Result.AddCommand(M2CommandToCommand(aCommand));
			aContinue := aContour.GetNextCommand(aCommand);
		end;
	except
		Result.Free;
		raise;
	end;
end;

procedure TProjectTreeForm.FindItemClick(Sender: TObject);
begin
	DoSearchInTreeView(ProjectTree, ProjectTree.Images);
end;



end.

