unit TransformControl;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls, ExtCtrls, ComCtrls, Transformer, ActnList, Menus, Geomet, Contnrs;

type
	TTransformControl = class(TCustomControl)
	private
		FTrLV: TListView;
		FPopupMenu: TPopupMenu;
		FRightPanel: TPanel;

		FAddTranslationBtn: TButton;
		FAddScalingBtn: TButton;
		FAddRotationBtn: TButton;
		FChangeBtn: TButton;
		FDeleteBtn: TButton;
		FClearBtn: TButton;
		FUpBtn: TButton;
		FDownBtn: TButton;

		procedure AddTranslationClick(Sender: TObject);
		procedure AddScalingClick(Sender: TObject);
		procedure AddRotationClick(Sender: TObject);
		procedure ChangeClick(Sender: TObject);
		procedure DeleteClick(Sender: TObject);
		procedure ClearClick(Sender: TObject);
		procedure UpClick(Sender: TObject);
		procedure DownClick(Sender: TObject);
		procedure TrLVDeletion(Sender: TObject; Item: TListItem);
		procedure TrLVResize(Sender: TObject);
	protected
		procedure CreateParams(var Params: TCreateParams); override;
		procedure ChangeScale(M, D: Integer); override;
		function  EditTransformItem(anItem: TTransformItem): Boolean;
	public
		constructor Create(aOwner: TComponent); override;

		procedure Clear;

		procedure SetData(aData: TTransformData);
		procedure GetData(aData: TTransformData);
		procedure GetTransform(var aTransform: TCoordSpace);

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

	published
		property Align;
		property Anchors;
		property BiDiMode;
		property Color;
		property Constraints;
		property Ctl3D;
		property Enabled;
		property Font;
		property ParentBiDiMode;
		property ParentColor;
		property ParentCtl3D;
		property ParentFont;
		property ParentShowHint;
		property PopupMenu;
		property ShowHint;
		property TabOrder;
		property TabStop;
		property Visible;

		property OnCanResize;
		property OnClick;
		property OnConstrainedResize;
		property OnDblClick;
		property OnEnter;
		property OnExit;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
		property OnResize;
	end;


resourcestring
	SWarrningRemoveTransformItem = 'Удалить элемент?';
	SWarrning = 'Предупреждение';


implementation

uses
	Math, InSysUtils, TrTranslations, TrScaling, TrRotation;

{ TTransformControl }

constructor TTransformControl.Create(aOwner: TComponent);
var
	M, D: Integer;

	function Adjust(aValue: Integer): Integer;
	begin
		Result := MulDiv(aValue, M, D);
	end;

	function EnsureMenu(aParent: TMenuItem; const aCaption: String; aShortCut: TShortCut = 0): TMenuItem;
	var
		i: Integer;
	begin
		for i := 0 to aParent.Count - 1 do begin
			Result := aParent[i];
			if SameText(Result.Caption, aCaption) then
				Exit;
		end;
		Result := TMenuItem.Create(aParent);
		Result.Caption := aCaption;
		Result.ShortCut := aShortCut;
		aParent.Add(Result);
	end;

	function AddMenuItem(aParent: TMenuItem; const aCaption: String;
		aShortCut: TShortCut; anEvent: TNotifyEvent): TMenuItem;
	begin
		Result := TMenuItem.Create(aParent);
		Result.Caption := aCaption;
		Result.ShortCut := aShortCut;
		Result.OnClick := anEvent;
		aParent.Add(Result);
	end;

	procedure AddMenuSeparator(aParent: TMenuItem);
	begin
		AddMenuItem(aParent, '-', 0, nil);
	end;

	function CreateButton(const aCaption: String; aParent: TWinControl;
		aLeft, aTop: Integer; anEvent: TNotifyEvent): TButton;
	begin
		Result := TButton.Create(Self);
		Result.Parent := aParent;
		Result.Caption := aCaption;
		Result.Visible := True;
		Result.BoundsRect := Rect(Adjust(aLeft), Adjust(aTop),
				Adjust(aLeft + 72), Adjust(aTop + 23));
		Result.OnClick := anEvent;
	end;

	function CreatePanel(aWidth: Integer): TPanel;
	begin
		Result := TPanel.Create(Self);
		Result.Parent := Self;
		Result.Caption := '';
		Result.Visible := True;
		Result.BoundsRect := Rect(0, 0, Adjust(aWidth), Adjust(aWidth));
		Result.ParentColor := True;
		Result.BevelOuter := bvNone;
	end;

begin
	inherited Create(aOwner);
	D := 96;
	M := Max(Screen.PixelsPerInch, D);

	ControlStyle := [csCaptureMouse, csClickEvents,
			csDoubleClicks, csReplicatable];
	Width := 300;
	Height := 240;

	FTrLV := TListView.Create(Self);
	FTrLV.Parent := Self;
	with FTrLV.Columns.Add do begin
		Caption := 'Трансформация';
		Width := 220;
	end;

	FTrLV.ColumnClick := False;
	FTrLV.HideSelection := False;
	FTrLV.ReadOnly := True;
	FTrLV.RowSelect := True;
	FTrLV.ViewStyle := vsReport;
	FTrLV.OnDeletion := TrLVDeletion;
	FTrLV.OnResize := TrLVResize;
	FTrLV.OnDblClick := ChangeClick;

	FRightPanel := CreatePanel(80);
	FRightPanel.Align := alRight;

	FTrLV.Align := alClient;

	FPopupMenu := TPopupMenu.Create(Self);
	FTrLV.PopupMenu := FPopupMenu;

	FAddTranslationBtn := CreateButton('Смещение', FRightPanel, 4, 10, AddTranslationClick);
	FAddScalingBtn := CreateButton('Увел./Сжат.', FRightPanel, 4, 35, AddScalingClick);
	FAddRotationBtn := CreateButton('Поворот', FRightPanel, 4, 60, AddRotationClick);

	FChangeBtn := CreateButton('Изменить', FRightPanel, 4, 95, ChangeClick);
	FDeleteBtn := CreateButton('Удалить', FRightPanel, 4, 120, DeleteClick);
	FClearBtn := CreateButton('Очистить', FRightPanel, 4, 145, ClearClick);

	FUpBtn := CreateButton('Поднять', FRightPanel, 4, 180, UpClick);
	FDownBtn := CreateButton('Опустить', FRightPanel, 4, 205, DownClick);

	AddMenuItem(EnsureMenu(FPopupMenu.Items, 'Добавить', ShortCut(VK_INSERT, [])), FAddTranslationBtn.Caption, 0, AddTranslationClick);
	AddMenuItem(EnsureMenu(FPopupMenu.Items, 'Добавить'), FAddScalingBtn.Caption, 0, AddScalingClick);
	AddMenuItem(EnsureMenu(FPopupMenu.Items, 'Добавить'), FAddRotationBtn.Caption, 0, AddRotationClick);
	AddMenuSeparator(FPopupMenu.Items);
	AddMenuItem(FPopupMenu.Items, FChangeBtn.Caption, ShortCut(VK_RETURN, []), ChangeClick);
	AddMenuItem(FPopupMenu.Items, FDeleteBtn.Caption, ShortCut(VK_DELETE, []), DeleteClick);
	AddMenuItem(FPopupMenu.Items, FClearBtn.Caption, 0, ClearClick);
	AddMenuSeparator(FPopupMenu.Items);
	AddMenuItem(FPopupMenu.Items, FUpBtn.Caption, ShortCut(VK_UP, [ssCtrl]), UpClick);
	AddMenuItem(FPopupMenu.Items, FDownBtn.Caption, ShortCut(VK_DOWN, [ssCtrl]), DownClick);
end;

procedure AddTranslationItemToListView(aList: TListView; anItem: TTransformItem; aSelect: Boolean = True);
begin
	with aList.Items.Add do begin
		Caption := anItem.GetCaption;
		Data := anItem;
		if aSelect then begin
			Selected := True;
			Focused := True;
		end;
	end;
end;

procedure TTransformControl.AddTranslationClick(Sender: TObject);
var
	anItem: TTransformItem;
begin
	anItem := TTransformTranslationItem.Create;
	try
		if EditTransformItem(anItem) then
			AddTranslationItemToListView(FTrLV, anItem)
		else
			anItem.Free;
	except
		anItem.Free;
	end;
end;

procedure TTransformControl.AddScalingClick(Sender: TObject);
var
	anItem: TTransformItem;
begin
	anItem := TTransformScalingItem.Create;
	try
		if EditTransformItem(anItem) then
			AddTranslationItemToListView(FTrLV, anItem)
		else
			anItem.Free;
	except
		anItem.Free;
	end;
end;

procedure TTransformControl.AddRotationClick(Sender: TObject);
var
	anItem: TTransformItem;
begin
	anItem := TTransformRotationItem.Create;
	try
		if EditTransformItem(anItem) then
			AddTranslationItemToListView(FTrLV, anItem)
		else
			anItem.Free;
	except
		anItem.Free;
	end;
end;

procedure TTransformControl.ChangeClick(Sender: TObject);
var
	aTr: TTransformItem;
begin
	if not Assigned(FTrLV.Selected) then
		Exit;

	aTr := FTrLV.Selected.Data;
	if EditTransformItem(aTr) then
		FTrLV.Selected.Caption := aTr.GetCaption;
end;

function TTransformControl.EditTransformItem(anItem: TTransformItem): Boolean;

	function EditTranslation(anItem: TTransformTranslationItem): Boolean;
	begin
		Result := DoEditTranslation(Self, anItem.X, anItem.Y)
	end;

	function EditScaling(anItem: TTransformScalingItem): Boolean;
	begin
		Result := DoEditScaling(Self, anItem.X, anItem.Y)
	end;

	function EditRotation(anItem: TTransformRotationItem): Boolean;
	begin
		Result := DoEditAngle(Self, anItem.Angle);
	end;

begin
	if anItem is TTransformTranslationItem then
		Result := EditTranslation(anItem as TTransformTranslationItem)
	else if anItem is TTransformScalingItem then
		Result := EditScaling(anItem as TTransformScalingItem)
	else if anItem is TTransformRotationItem then
		Result := EditRotation(anItem as TTransformRotationItem)
	else
		Result := False;
end;



procedure TTransformControl.DeleteClick(Sender: TObject);
var
	i: Integer;
begin
	if not Assigned(FTrLV.Selected) then
		Exit;

	if (Sender is TMenuItem) and
		(MessageBox(Handle, PChar(SWarrningRemoveTransformItem), PChar(SWarrning),
			MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) <> IDYES)
	then
		Exit;

	i := FTrLV.Selected.Index;
	FTrLV.Selected.Free;
	if i < FTrLV.Items.Count then
		FTrLV.ItemIndex := i
	else
		FTrLV.ItemIndex := FTrLV.Items.Count - 1;
end;

procedure TTransformControl.ClearClick(Sender: TObject);
begin
	FTrLV.Clear;
end;

procedure TTransformControl.UpClick(Sender: TObject);
var
	aTr: TTransformItem;
	anItem: TListItem;
	i: Integer;
begin
	if Assigned(FTrLV.Selected) and (FTrLV.Selected.Index > 0) then begin
		i := FTrLV.Selected.Index;
		aTr := FTrLV.Selected.Data;
		FTrLV.Selected.Data := nil;
		FTrLV.Selected.Free;
		anItem := FTrLV.Items.Insert(i - 1);
		with anItem do begin
			Caption := aTr.GetCaption;
			Data := aTr;
		end;
		FTrLV.Selected := anItem;
		FTrLV.Selected.Focused := True;
	end;
end;

procedure TTransformControl.DownClick(Sender: TObject);
var
	anItem: TListItem;
	aTr: TTransformItem;
	i: Integer;
begin
	if Assigned(FTrLV.Selected) and (FTrLV.Selected.Index < FTrLV.Items.Count - 1) then begin
		i := FTrLV.Selected.Index;
		aTr := FTrLV.Selected.Data;
		FTrLV.Selected.Data := nil;
		FTrLV.Selected.Free;
		anItem := FTrLV.Items.Insert(i + 1);
		with anItem do begin
			Caption := aTr.GetCaption;
			Data := aTr;
		end;
		FTrLV.Selected := anItem;
		FTrLV.Selected.Focused := True;
	end;
end;

procedure TTransformControl.TrLVDeletion(Sender: TObject; Item: TListItem);
begin
	TTransformItem(Item.Data).Free;
end;

procedure TTransformControl.TrLVResize(Sender: TObject);
begin
	FTrLV.Columns[0].Width := FTrLV.ClientWidth;
end;

procedure TTransformControl.CreateParams(var Params: TCreateParams);
begin
	inherited CreateParams(Params);
	Params.Style := Params.Style or WS_CLIPCHILDREN;
	Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT;
end;

procedure TTransformControl.ChangeScale(M, D: Integer);
var
	X, Y, W, H: Integer;
begin
	if csLoading in ComponentState then begin
		X := MulDiv(Left, M, D);
		Y := MulDiv(Top, M, D);
		W := MulDiv(Left + Width, M, D) - X;
		H := MulDiv(Top + Height, M, D) - Y;
		SetBounds(X, Y, W, H);
		if not ParentFont then
			Font.Size := MulDiv(Font.Size, M, D);
		ScalingFlags := [];
	end
	else
		inherited ChangeScale(M, D);
end;

procedure TTransformControl.GetData(aData: TTransformData);
var
	i: Integer;
begin
	aData.Clear;
	for i := 0 to FTrLV.Items.Count - 1 do
		aData.Add(TTransformItem(FTrLV.Items[i].Data).CreateCopy);
end;

procedure TTransformControl.GetTransform(var aTransform: TCoordSpace);
var
	i: Integer;
begin
	aTransform.Clear;
	for i := 0 to FTrLV.Items.Count - 1 do
		TTransformItem(FTrLV.Items[i].Data).AddTo(aTransform);
end;

procedure TTransformControl.SetData(aData: TTransformData);
var
	i: Integer;
begin
	FTrLV.Items.BeginUpdate;
	try
		FTrLV.Clear;
		for i := 0 to aData.Count - 1 do
			AddTranslationItemToListView(FTrLV, aData[i].CreateCopy, i = 0);
	finally
		FTrLV.Items.EndUpdate;
	end;
end;

procedure TTransformControl.LoadFromStream(aStream: TStream);
var
	aData: TTransformData;
begin
	aData := TTransformData.Create;
	try
		aData.LoadFromStream(aStream);
		SetData(aData);
	finally
		aData.Free;
	end;
end;

procedure TTransformControl.SaveToStream(aStream: TStream);
var
	aData: TTransformData;
begin
	aData := TTransformData.Create;
	try
		GetData(aData);
		aData.SaveToStream(aStream);
	finally
		aData.Free;
	end;
end;

procedure TTransformControl.Clear;
begin
	FTrLV.Clear;
end;


end.

