| Author |
 Topic  |
|
|
bmesser
United Kingdom
234 Posts |
 Posted - Jan 13 2014 : 05:35:15
|
Hi
I am just looking at the "Marker" demo and trying to figure out how to work out a bearing and distance between point and the arrow - this is all to do with mapping and to perform this calculation I obviously need TPoint values for both ends of the line, so I can add text in the label such as 265°/125 KM.
I thought I'd found a way to do it using values from the ObjectExtents property but this always seems to return zero left and right values which doesn't help. Is there a way I can get at these two values?
Bruce. |
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 13 2014 : 06:11:55
|
Hi
Found the obvious ObjTop, ObjWidth, ObHeight & ObjLeft properties - so I can now make some progress!
Bruce.
|
 |
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 13 2014 : 09:39:05
|
Hi
I've now found formulas on how to calculate a 'BearingTo' and a 'DistanceTo' from two points, but I still can't find a way of calculating both end points of a line object (an iesOUTARROW as in the "Marker" demo).
I'm not particularly bothered about identifying which is the "arrow" end, as long as I have the X,Y values for both ends I can then map them to their latitude and longitude, and then use the two functions I mentioned above to work out the distance and bearing between them.
Any help would be appreciated.
Bruce.
|
|
|
|
w2m
USA
1990 Posts |
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 13 2014 : 11:08:30
|
Bill
I think these extent calculations using the object maybe inflated by the width of the label that I am using. What I want to get values for are the two points at either end of the line.
Bruce.
 |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 13 2014 : 13:35:39
|
Based on some tests here, I do not believe the ObjText has any affect on the line coordinates. I suspect your problem is you are not converting XY values to display the positions:
{ Convert the Screen coordinates to Bitmap coordinates }
iX := ImageEnVect1.XScr2Bmp(X);
iY := ImageEnVect1.YScr2Bmp(Y);
{ Prevent exception by making sure iX and iY are inside the bitmap }
if (iX >= 0) and (iY >= 0) and (iX <= ImageEnVect1.IEBitmap.Width - 1) and
(iY <= ImageEnVect1.IEBitmap.Height - 1) then
begin
LabelX1.Caption := 'X: ' + IntToStr(iX);
LabelY1.Caption := 'Y: ' + IntToStr(iY);
end;
Is the ImageEnVect1.SelectionBase = iesbClientArea?
I also suspect that when the object is selected the start and end of a line is in the center of the grip.
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 13 2014 : 13:40:59
|
| I'll give it a go and get back to you - you may well be right and often are! |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 13 2014 : 14:16:50
|
Also if you are using layers which layer are the objects on?
TImageEnVect.ObjAnchorToLayers
Declaration
property ObjAnchorToLayers:boolean;
Description
When true (default), all objects are anchored to a layer (using ObjLayer property).
Otherwise (the old behavior) objects are just painted over all layers.
With layers you need:
iX := ImageEnVect1.Layers[ImageEnVect1.LayersCurrent].ConvXScr2Bmp(X);
iY := ImageEnVect1.Layers[ImageEnVect1.LayersCurrent].ConvYScr2Bmp(Y);
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 13 2014 : 16:10:51
|
Hi Bill
I have the above Anchors property set false so the objects appear on top of all the other layers.
I've had a look at your suggestion and it doesn't really help. I believe there is no way from the properties ObjLeft,ObjTop etc that you can calculate the opposite end of the line, the values are never negative and always positive, so although you have one location, you can't figure out the position of the other in relation to it.
I think that the only way round the problem is to use the back buffer and manually take over the drawing.
Bruce. |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 13 2014 : 17:24:37
|
I just emailed you a demo that gets the correct Start and end XY values. I opted to use ImageEnVect1.GetObjRect(hobj, iRect to get the TRect of the object and then used that to calculate the start XY and end of line XY values.
I just found a small error in what I sent you:
Change iLineLength := iObjectWidth to iLineLength := Abs(iObjectWidth);
The calculated XY values for the start and the end of the line seem to be accurate now, in that the values match the screen coordinates.
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
|
Uwe
284 Posts |
Posted - Jan 14 2014 : 08:54:03
|
Hi Bill
I've seen you doing this a couple of times now already: participating in a thread and then sending the OP a demo without answering the question within the thread. Are those demos part of your book, or why don't you post in the relevant thread? Just wondering because I'm sure that lots of other people would like to see the answer as well.
Thanks
-Uwe |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 14 2014 : 09:35:20
|
Uwe,
No it is not for my book.
The app was not simple and as such I could not post the code. Please remember that I do not work for ImageEn, so what ever I do here I do at my own discretion just like you do... and in fact I did answer the question "I opted to use ImageEnVect1.GetObjRect(hobj, iRect to get the TRect of the object and then used that to calculate the start XY and end of line XY values." although I admit is it not as detailed of an answer that I usually give.
Having said that, you are welcome to the demo if you want it... Just email me.
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
|
bmesser
United Kingdom
234 Posts |
Posted - Jan 14 2014 : 11:35:50
|
Hi Bill
All bearings and distances now working in each quadrant!
Thanks for all your hard work and persistence.
I had written a BackBuffer canvas solution, but that leaves you with a lot of extra coding and the result looks poor because I don’t think its anti-aliased like the finish that you get when using objects and the built in drawing.
Bruce.
|
|
|
|
Uwe
284 Posts |
Posted - Jan 14 2014 : 17:44:04
|
Bill
quote:
you are welcome to the demo if you want it
Not necessary, but thanks a lot. I was only curious why you are sending out demos instead of posting the code directly in the forum, that's all.
-Uwe |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 15 2014 : 09:03:46
|
I decided to post the code. Although the code is a little long it provides information on how to use an object's TRect to calculate a line object x and y values for the start and ending point of a line object. The line caption plays no part in the objects dimensions even though the caption is part of the object.
Here is the dfm:
object Form1: TForm1
Left = 200
Top = 108
ActiveControl = Open1
Caption =
'ImageEnVect LineLabelObject X and Y Values For The Start And End' +
' Of A Line'
ClientHeight = 729
ClientWidth = 1008
Color = clBtnFace
Constraints.MinWidth = 920
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
OldCreateOrder = True
Position = poMainFormCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 15
object ImageEnVect1: TImageEnVect
Left = 0
Top = 190
Width = 1008
Height = 493
Cursor = 1784
Background = clWindow
ParentCtl3D = False
OnLayerNotify = ImageEnVect1LayerNotify
EnableInteractionHints = True
Align = alClient
ParentShowHint = False
PopupMenu = PopupMenuImageEnVect1
ShowHint = True
TabOrder = 0
OnMouseMove = ImageEnVect1MouseMove
OnUserSelectObject = ImageEnVect1UserSelectObject
OnUserDeselectObject = ImageEnVect1UserDeselectObject
OnNewObject = ImageEnVect1NewObject
OnObjectMoveResize = ImageEnVect1ObjectMoveResize
OnObjectClick = ImageEnVect1ObjectClick
end
object Panel1: TPanel
Left = 0
Top = 0
Width = 1008
Height = 185
Align = alTop
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
1008
185)
object Insert1: TSpeedButton
Left = 89
Top = 8
Width = 91
Height = 25
Hint = 'Insert a text arrow'
AllowAllUp = True
GroupIndex = 1
Caption = 'Insert Object'
ParentShowHint = False
ShowHint = True
OnClick = Insert1Click
end
object LabelTextLength1: TLabel
Left = 13
Top = 82
Width = 65
Height = 15
Caption = 'Text Length:'
end
object LabelTextHeight1: TLabel
Left = 13
Top = 101
Width = 64
Height = 15
Caption = 'Text Height:'
end
object LabelLineStart1: TLabel
Left = 13
Top = 120
Width = 52
Height = 15
Caption = 'Line Start:'
end
object LabelLineEnd1: TLabel
Left = 13
Top = 139
Width = 48
Height = 15
Caption = 'Line End:'
end
object LabelObjectStart1: TLabel
Left = 13
Top = 44
Width = 65
Height = 15
Caption = 'Object Start:'
end
object LabelObjectEnd1: TLabel
Left = 13
Top = 63
Width = 61
Height = 15
Caption = 'Object End:'
end
object LabelX1: TLabel
Left = 302
Top = 44
Width = 10
Height = 15
Caption = 'X:'
end
object LabelY1: TLabel
Left = 302
Top = 63
Width = 10
Height = 15
Caption = 'Y:'
end
object LabelLineLength1: TLabel
Left = 13
Top = 158
Width = 65
Height = 15
Caption = 'Line Length:'
end
object LabelLayer1: TLabel
Left = 302
Top = 85
Width = 40
Height = 15
Caption = 'Layer: 1'
end
object LabelLayers1: TLabel
Left = 302
Top = 104
Width = 45
Height = 15
Caption = 'Layers: 1'
end
object LabelObject1: TLabel
Left = 302
Top = 123
Width = 47
Height = 15
Caption = 'Object: 0'
end
object LabelObjects1: TLabel
Left = 302
Top = 142
Width = 52
Height = 15
Caption = 'Objects: 0'
end
object Open1: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Hint = 'Open a bckground image'
Caption = 'Open'
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = Open1Click
end
object AddLayer1: TButton
Left = 422
Top = 8
Width = 75
Height = 25
Hint = 'Add a layer'
Caption = 'Add Layer'
ParentShowHint = False
ShowHint = True
TabOrder = 1
OnClick = AddLayer1Click
end
object RemoveLayer1: TButton
Left = 503
Top = 8
Width = 97
Height = 25
Hint = 'Remove selected layer'
Caption = 'Remove Layer'
ParentShowHint = False
ShowHint = True
TabOrder = 2
OnClick = RemoveLayer1Click
end
object Selection1: TButton
Left = 606
Top = 8
Width = 88
Height = 25
Caption = 'Selection'
DropDownMenu = PopupMenu1
Style = bsSplitButton
TabOrder = 3
end
object Exit1: TButton
Left = 917
Top = 8
Width = 75
Height = 25
Hint = 'Exit to windows'
Anchors = [akTop, akRight]
Caption = 'Exit'
ParentShowHint = False
ShowHint = True
TabOrder = 4
OnClick = Exit1Click
end
object RemoveObject1: TButton
Left = 186
Top = 8
Width = 107
Height = 25
Hint = 'Remove selected objects'
Caption = 'Remove Object'
ParentShowHint = False
ShowHint = True
TabOrder = 5
OnClick = RemoveObject1Click
end
object MultipleObjects1: TCheckBox
Left = 702
Top = 13
Width = 119
Height = 17
Caption = 'Multiple Objects'
TabOrder = 6
end
object RemoveAllObjects1: TButton
Left = 299
Top = 8
Width = 117
Height = 25
Caption = 'Remove All Objects'
ParentShowHint = False
ShowHint = True
TabOrder = 7
OnClick = RemoveAllObjects1Click
end
end
object Panel2: TPanel
Left = 0
Top = 185
Width = 1008
Height = 5
Align = alTop
BevelOuter = bvNone
Color = 55295
ParentBackground = False
TabOrder = 2
end
object Panel3: TPanel
Left = 0
Top = 683
Width = 1008
Height = 5
Align = alBottom
BevelOuter = bvNone
Color = 55295
ParentBackground = False
TabOrder = 3
end
object Panel4: TPanel
Left = 0
Top = 688
Width = 1008
Height = 41
Align = alBottom
BevelOuter = bvNone
TabOrder = 4
DesignSize = (
1008
41)
object Button1: TButton
Left = 917
Top = 8
Width = 75
Height = 25
Hint = 'Exit to windows'
Anchors = [akTop, akRight]
Caption = 'Exit'
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnClick = Exit1Click
end
end
object PopupMenu1: TPopupMenu
Left = 19
Top = 230
object None1: TMenuItem
AutoCheck = True
Caption = 'None'
GroupIndex = 1
RadioItem = True
OnClick = None1Click
end
object PanZoom1: TMenuItem
AutoCheck = True
Caption = 'Pan/Zoom'
Checked = True
Default = True
GroupIndex = 1
RadioItem = True
OnClick = PanZoom1Click
end
object Layers1: TMenuItem
AutoCheck = True
Caption = 'Layers'
GroupIndex = 1
RadioItem = True
OnClick = Layers1Click
end
object Objects1: TMenuItem
AutoCheck = True
Caption = 'Objects'
GroupIndex = 1
RadioItem = True
OnClick = Objects1Click
end
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 19
Top = 202
end
object SavePictureDialog1: TSavePictureDialog
Left = 47
Top = 202
end
object PopupMenuImageEnVect1: TPopupMenu
OnPopup = PopupMenuImageEnVect1Popup
Left = 47
Top = 230
object RemoveObject2: TMenuItem
Caption = 'Remove Object'
OnClick = RemoveObject1Click
end
object RemoveAllObjects2: TMenuItem
Caption = 'Remove All Objects'
OnClick = RemoveAllObjects1Click
end
object AddLayer2: TMenuItem
Caption = 'Add Layer'
OnClick = AddLayer1Click
end
object RemoveLayer2: TMenuItem
Caption = 'Remove Layer'
OnClick = RemoveLayer1Click
end
end
end
Here is the code:
(* -----------------------------------------------------------------------------
ImageEnVect LineLabelObject Start and End X and Y Values : 1.0
Copyright © 2014 : Copyright Adirondack Software & Graphics
Last Modification : 01-15-2014
Source File : Unit1.pas
Compiler : Delphi XE4 (Probably will compile in earlier
versions of Delphi)
ImageEn Version : 5.0.5
PlatForm : VCL Windows 32-Bit
Operating System : Windows 8.1
This file is copyright (C) W W Miller, 1986-2014.
It may be used without restriction. This code distributed on an "AS IS"
basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.
--------------------------------------------------------------------------- *)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, Buttons, ExtCtrls, StdCtrls, ExtDlgs, ieview, imageenview,
hyiedefs, hyieutils, ievect;
type
TForm1 = class(TForm)
ImageEnVect1: TImageEnVect;
Panel1: TPanel;
Insert1: TSpeedButton;
Open1: TButton;
LabelTextLength1: TLabel;
LabelTextHeight1: TLabel;
LabelLineStart1: TLabel;
LabelLineEnd1: TLabel;
LabelObjectStart1: TLabel;
LabelObjectEnd1: TLabel;
LabelX1: TLabel;
LabelY1: TLabel;
LabelLineLength1: TLabel;
AddLayer1: TButton;
RemoveLayer1: TButton;
Selection1: TButton;
PopupMenu1: TPopupMenu;
PanZoom1: TMenuItem;
Layers1: TMenuItem;
Objects1: TMenuItem;
None1: TMenuItem;
LabelLayer1: TLabel;
LabelLayers1: TLabel;
Panel2: TPanel;
Panel3: TPanel;
Exit1: TButton;
Panel4: TPanel;
Button1: TButton;
RemoveObject1: TButton;
LabelObject1: TLabel;
LabelObjects1: TLabel;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
MultipleObjects1: TCheckBox;
RemoveAllObjects1: TButton;
PopupMenuImageEnVect1: TPopupMenu;
RemoveObject2: TMenuItem;
RemoveAllObjects2: TMenuItem;
AddLayer2: TMenuItem;
RemoveLayer2: TMenuItem;
procedure Open1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Insert1Click(Sender: TObject);
procedure ImageEnVect1NewObject(Sender: TObject; hobj: Integer);
procedure ImageEnVect1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure ImageEnVect1ObjectMoveResize(Sender: TObject; hobj, Grip: Integer;
var OffsetX, OffsetY: Integer);
procedure AddLayer1Click(Sender: TObject);
procedure RemoveLayer1Click(Sender: TObject);
procedure None1Click(Sender: TObject);
procedure PanZoom1Click(Sender: TObject);
procedure Layers1Click(Sender: TObject);
procedure Objects1Click(Sender: TObject);
procedure ImageEnVect1LayerNotify(Sender: TObject; layer: Integer;
event: TIELayerEvent);
procedure Exit1Click(Sender: TObject);
procedure RemoveObject1Click(Sender: TObject);
procedure ImageEnVect1UserSelectObject(Sender: TObject; hobj: Integer);
procedure ImageEnVect1UserDeselectObject(Sender: TObject; hobj: Integer);
procedure ImageEnVect1ObjectClick(Sender: TObject; hobj: Integer);
procedure FormDestroy(Sender: TObject);
procedure RemoveAllObjects1Click(Sender: TObject);
procedure PopupMenuImageEnVect1Popup(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AddLayer1Click(Sender: TObject);
{ Add a layer. }
var
iLayer: Integer;
iRGB: TRGB;
begin
iLayer := ImageEnVect1.LayersAdd;
ImageEnVect1.LayersCurrent := iLayer;
ImageEnVect1.layers[iLayer].Visible := True;
ImageEnVect1.layers[iLayer].PosX := 0;
ImageEnVect1.layers[iLayer].PosY := 0;
ImageEnVect1.layers[iLayer].Width := ImageEnVect1.IEBitmap.Width;
ImageEnVect1.layers[iLayer].Height := ImageEnVect1.IEBitmap.Height;
ImageEnVect1.CurrentLayer.VisibleBox := True;
ImageEnVect1.CurrentLayer.Selectable := True;
ImageEnVect1.LayersDrawBox := True;
LabelLayer1.Caption := 'Layer: ' + IntToStr(iLayer);
LabelLayers1.Caption := 'Layers: ' + IntToStr(ImageEnVect1.LayersCount);
{ If a layer is moved outside of layer 0, then crop the layer
If a layer is moved or resized beyond the bounds of layer 0, the image
will be resized to the largest layer with out the call below }
ImageEnVect1.layers[iLayer].Cropped := True;
{ Make the layer transparent }
iRGB := ImageEnVect1.IEBitmap.Pixels[0, ImageEnVect1.IEBitmap.Height - 1];
ImageEnVect1.Proc.SetTransparentColors(iRGB, iRGB, 0);
ImageEnVect1.ObjLayer[-1] := ImageEnVect1.LayersCurrent;
RemoveLayer1.Enabled := ImageEnVect1.LayersCount > 0;
end;
procedure TForm1.Open1Click(Sender: TObject);
{ Open a background image. }
begin
if OpenPictureDialog1.Execute then
if FileExists(OpenPictureDialog1.FileName) then
begin
ImageEnVect1.IO.LoadFromFile(OpenPictureDialog1.FileName);
ImageEnVect1.RemoveAllObjects;
if ImageEnVect1.LayersCount = 1 then
begin
ImageEnVect1.layers[0].Visible := True;
ImageEnVect1.layers[0].PosX := 0;
ImageEnVect1.layers[0].PosY := 0;
ImageEnVect1.layers[0].Width := ImageEnVect1.IEBitmap.Width;
ImageEnVect1.layers[0].Height := ImageEnVect1.IEBitmap.Height;
ImageEnVect1.CurrentLayer.VisibleBox := True;
ImageEnVect1.CurrentLayer.Selectable := True;
ImageEnVect1.LayersDrawBox := True;
end;
end;
end;
procedure TForm1.Exit1Click(Sender: TObject);
{ Exit to windows. }
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
{ Set initial parameters. }
begin
{ Register picture file formats. }
IERegisterFormats;
OpenPictureDialog1.Filter := GraphicFilter(TGraphic);
SavePictureDialog1.Filter := GraphicFilter(TGraphic);
ImageEnVect1.MouseInteract := [];
ImageEnVect1.MouseInteractVt := [];
{ Set the object properties for the next inserted object }
ImageEnVect1.ObjFontHeight[IEV_NEXT_INSERTED_OBJECT] := -11;
ImageEnVect1.ObjFontStyles[IEV_NEXT_INSERTED_OBJECT] := [fsBold];
ImageEnVect1.ObjLabelBorder[IEV_NEXT_INSERTED_OBJECT] := ielNone;
ImageEnVect1.ObjLabelBrushColor[IEV_NEXT_INSERTED_OBJECT] := $0000D7FF;
ImageEnVect1.ObjEndShape[IEV_NEXT_INSERTED_OBJECT] := iesOUTARROW;
ImageEnVect1.ObjBrushColor[IEV_NEXT_INSERTED_OBJECT] := clRed;
ImageEnVect1.ObjBrushStyle[IEV_NEXT_INSERTED_OBJECT] := bsSolid;
ImageEnVect1.ObjAnchorToLayers := True;
{ Anchor the objects to the current layer }
ImageEnVect1.ObjLayer[IEV_NEXT_INSERTED_OBJECT] := ImageEnVect1.LayersCurrent;
RemoveObject1.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveObject2.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveAllObjects1.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveAllObjects2.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveLayer1.Enabled := ImageEnVect1.LayersCount > 1;
RemoveLayer2.Enabled := ImageEnVect1.LayersCount > 1;
{ Allow panning and zoom }
ImageEnVect1.Gestures.Pan.Enabled := True;
ImageEnVect1.Gestures.Zoom.Enabled := True;
{ Select objects even if they are transparent }
ImageEnVect1.SelectionOptions := ImageEnVect1.SelectionOptions +
[iesoSelectTranspLayers];
end;
procedure TForm1.FormDestroy(Sender: TObject);
{ Unregister picture file formats. }
begin
IEUnRegisterFormats;
end;
procedure TForm1.Insert1Click(Sender: TObject);
{ Set PutLineLabel or ObjectSelect. }
begin
if Insert1.Down then
ImageEnVect1.MouseInteractVt := [miPutLineLabel]
else
begin
ImageEnVect1.MouseInteractVt := [miObjectSelect];
Objects1.Checked := True;
end;
end;
procedure TForm1.ImageEnVect1LayerNotify(Sender: TObject; layer: Integer;
event: TIELayerEvent);
{ Show the selected layer. }
begin
LabelLayer1.Caption := 'Layer: ' + IntToStr(layer + 1);
RemoveLayer1.Enabled := ImageEnVect1.LayersCount > 1;
end;
procedure TForm1.ImageEnVect1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
{ Show the XY position when the cirsor moves. }
var
iX: Integer;
iY: Integer;
begin
{ Convert the Screen coordinates to Bitmap Adjusting for Layer coordinates }
iX := ImageEnVect1.XScr2Bmp(X);
iY := ImageEnVect1.YScr2Bmp(Y);
{ Prevent exception by making sure iX and iY are inside the bitmap }
if (iX >= 0) and (iY >= 0) and (iX <= ImageEnVect1.IEBitmap.Width - 1) and
(iY <= ImageEnVect1.IEBitmap.Height - 1) then
begin
LabelX1.Caption := 'X: ' + IntToStr(iX);
LabelY1.Caption := 'Y: ' + IntToStr(iY);
end;
end;
procedure TForm1.ImageEnVect1NewObject(Sender: TObject; hobj: Integer);
{ Update the GUI. }
var
iTextCaption: string;
iObjectLeft: Integer;
iObjectTop: Integer;
iObjectHeight: Integer;
iObjectWidth: Integer;
iLineLength: Integer;
iTextLength: Integer;
iTextHeight: Integer;
iRect: TRect;
iLineEndX: Integer;
iLineEndY: Integer;
begin
ImageEnVect1.Gestures.Pan.Enabled := false;
ImageEnVect1.Gestures.Zoom.Enabled := false;
RemoveObject1.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveAllObjects2.Enabled := ImageEnVect1.ObjectsCount > 0;
{ Get the object rectangle }
ImageEnVect1.GetObjRect(hobj, iRect);
iObjectLeft := iRect.Left;
iObjectTop := iRect.Top;
iObjectWidth := iRect.Right - iRect.Left;
iObjectHeight := iRect.Bottom - iRect.Top;
iLineLength := Abs(iObjectWidth);
LabelObjectStart1.Caption := 'Object Start: ' + ' X: ' + IntToStr(iObjectLeft)
+ ' Y: ' + IntToStr(iObjectTop);
LabelObjectEnd1.Caption := 'Object End: ' + ' X: ' +
IntToStr(iObjectLeft + iObjectWidth) + ' Y: ' +
IntToStr(iObjectTop + iObjectHeight);
LabelLineStart1.Caption := 'Line Start: ' + ' X: ' + IntToStr(iObjectLeft) +
' Y: ' + IntToStr(iObjectTop);
LabelLineLength1.Caption := 'Line Length: ' + IntToStr(iLineLength);
{ Calculate the Line X position }
if iRect.Right > iRect.Left then
iLineEndX := iObjectLeft + iLineLength
else
iLineEndX := iRect.Right;
{ Calculate the Line Y position }
if iRect.Bottom > iRect.Top then
iLineEndY := iObjectTop + iObjectHeight
else
iLineEndY := iRect.Bottom;
LabelLineEnd1.Caption := 'Line End: ' + ' X: ' + IntToStr(iLineEndX) + ' Y: '
+ IntToStr(iLineEndY);
iTextCaption := 'Start ' + ' X: ' + IntToStr(iObjectLeft) + ' Y: ' +
IntToStr(iObjectTop) + ' End ' + ' X: ' + IntToStr(iLineEndX) + ' Y: ' +
IntToStr(iLineEndY);
ImageEnVect1.ObjText[hobj] := ansistring(iTextCaption);
iTextLength := ImageEnVect1.Bitmap.Canvas.TextExtent
(string(ImageEnVect1.ObjText[hobj])).cx;
iTextHeight := ImageEnVect1.Bitmap.Canvas.TextExtent
(string(ImageEnVect1.ObjText[hobj])).cy;
LabelTextLength1.Caption := 'Text Length: ' + IntToStr(iTextLength);
LabelTextHeight1.Caption := 'Text Height: ' + IntToStr(iTextHeight);
LabelLineLength1.Caption := 'Line Length: ' + IntToStr(iLineLength);
LabelObject1.Caption := 'Object: ' + IntToStr(hobj + 1);
LabelObjects1.Caption := 'Objects: ' + IntToStr(ImageEnVect1.ObjectsCount);
{ if MultipleObjects1 is checked then continue to allow inserting object else
set MouseInteractVt to miObjectSelect }
if not MultipleObjects1.Checked then
begin
Insert1.Down := false;
ImageEnVect1.MouseInteractVt := [miObjectSelect];
Objects1.Checked := True;
end;
end;
procedure TForm1.ImageEnVect1ObjectClick(Sender: TObject; hobj: Integer);
{ Show the selected object number. }
begin
LabelObject1.Caption := 'Object: ' + IntToStr(hobj + 1);
end;
procedure TForm1.ImageEnVect1ObjectMoveResize(Sender: TObject;
hobj, Grip: Integer; var OffsetX, OffsetY: Integer);
{ Update the GUI. }
var
i: Integer;
iTextCaption: string;
ihObj: Integer;
iObjectLeft: Integer;
iObjectTop: Integer;
iObjectWidth: Integer;
iObjectHeight: Integer;
iLineLength: Integer;
iRect: TRect;
iLineEndX: Integer;
iLineEndY: Integer;
begin
ImageEnVect1.GetObjRect(hObj, iRect);
iObjectLeft := iRect.Left;
iObjectTop := iRect.Top;
iObjectWidth := iRect.Right - iRect.Left;
iObjectHeight := iRect.Bottom - iRect.Top;
iLineLength := Abs(iObjectWidth);
LabelObjectStart1.Caption := 'Object Start: ' + ' X: ' + IntToStr(iObjectLeft)
+ ' Y: ' + IntToStr(iObjectTop);
LabelObjectEnd1.Caption := 'Object End: ' + ' X: ' +
IntToStr(iObjectLeft + iObjectWidth) + ' Y: ' +
IntToStr(iObjectTop + iObjectHeight);
LabelLineStart1.Caption := 'Line Start: ' + ' X: ' + IntToStr(iObjectLeft) +
' Y: ' + IntToStr(iObjectTop);
{ Calculate the Line X position }
if iRect.Right > iRect.Left then
iLineEndX := iObjectLeft + iLineLength
else
iLineEndX := iRect.Right;
{ Calculate the Line Y position }
if iRect.Bottom > iRect.Top then
iLineEndY := iObjectTop + iObjectHeight
else
iLineEndY := iRect.Bottom;
LabelLineEnd1.Caption := 'Line End: ' + ' X: ' + IntToStr(iLineEndX) + ' Y: '
+ IntToStr(iLineEndY);
iTextCaption := 'Start ' + ' X: ' + IntToStr(iObjectLeft) + ' Y: ' +
IntToStr(iObjectTop) + ' End ' + ' X: ' + IntToStr(iLineEndX) + ' Y: ' +
IntToStr(iLineEndY);
ImageEnVect1.ObjText[hobj] := ansistring(iTextCaption);
LabelLineLength1.Caption := 'Line Length: ' + IntToStr(iLineLength);
end;
procedure TForm1.ImageEnVect1UserDeselectObject(Sender: TObject; hobj: Integer);
{ Show selected object number. }
begin
LabelObject1.Caption := 'Object: ' +
IntToStr(ImageEnVect1.SelObjects[hobj] + 1);
RemoveObject1.Enabled := ImageEnVect1.ObjectsCount > 0;
end;
procedure TForm1.ImageEnVect1UserSelectObject(Sender: TObject; hobj: Integer);
{ Show selected object number. }
begin
LabelObject1.Caption := 'Object: ' +
IntToStr(ImageEnVect1.SelObjects[hobj] + 1);
RemoveObject1.Enabled := ImageEnVect1.ObjectsCount > 0;
end;
procedure TForm1.Layers1Click(Sender: TObject);
{ Select layers. }
begin
ImageEnVect1.MouseInteract := [miMoveLayers, miResizeLayers];
ImageEnVect1.MouseInteractVt := [];
ImageEnVect1.Gestures.Pan.Enabled := false;
ImageEnVect1.Gestures.Zoom.Enabled := false;
ImageEnVect1.Gestures.LayerMove.Enabled := True;
end;
procedure TForm1.None1Click(Sender: TObject);
{ Cancel selections. }
begin
ImageEnVect1.MouseInteract := [];
ImageEnVect1.MouseInteractVt := [];
ImageEnVect1.Gestures.Pan.Enabled := false;
ImageEnVect1.Gestures.Zoom.Enabled := false;
ImageEnVect1.Gestures.LayerMove.Enabled := false;
end;
procedure TForm1.Objects1Click(Sender: TObject);
{ Select objects. }
begin
ImageEnVect1.MouseInteractVt := [miObjectSelect];
ImageEnVect1.Gestures.Pan.Enabled := false;
ImageEnVect1.Gestures.Zoom.Enabled := false;
end;
procedure TForm1.PanZoom1Click(Sender: TObject);
{ Select Pan/Zoom. }
begin
ImageEnVect1.MouseInteract := [miScroll];
ImageEnVect1.MouseInteractVt := [];
ImageEnVect1.Gestures.Pan.Enabled := True;
ImageEnVect1.Gestures.Zoom.Enabled := True;
ImageEnVect1.Gestures.LayerMove.Enabled := false;
end;
procedure TForm1.PopupMenuImageEnVect1Popup(Sender: TObject);
{ Update the GUI. }
begin
RemoveObject2.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveAllObjects2.Enabled := ImageEnVect1.ObjectsCount > 0;
RemoveLayer2.Enabled := ImageEnVect1.LayersCount > 1;
end;
procedure TForm1.RemoveAllObjects1Click(Sender: TObject);
{ Remove All Objects. }
begin
ImageEnVect1.RemoveAllObjects;
LabelObjectStart1.Caption := 'Object Start:';
LabelObjectEnd1.Caption := 'Object End:';
LabelLineStart1.Caption := 'Line Start:';
LabelTextLength1.Caption := 'Text Length:';
LabelTextHeight1.Caption := 'Text Height:';
LabelLineStart1.Caption := 'Line Start:';
LabelLineEnd1.Caption := 'Line End:';
LabelLineLength1.Caption := 'Line Length:';
end;
procedure TForm1.RemoveLayer1Click(Sender: TObject);
{ Remove the selected layer. }
var
i: Integer;
iLayer: Integer;
ihObj: Integer;
begin
iLayer := ImageEnVect1.LayersCurrent;
ImageEnVect1.LayersRemove(iLayer);
LabelLayer1.Caption := 'Layer: ' + IntToStr(iLayer);
LabelLayers1.Caption := 'Layers: ' + IntToStr(ImageEnVect1.LayersCount);
RemoveLayer1.Enabled := ImageEnVect1.LayersCount > 1;
ihObj := -1;
with ImageEnVect1 do
for i := 0 to SelObjectsCount - 1 do
begin
if i >= 0 then
ihObj := SelObjects[i];
{ just get the first selected object }
break;
end;
if ihObj > -1 then
LabelObject1.Caption := 'Object: ' + IntToStr(ihObj + 1)
else
LabelObject1.Caption := 'Object:';
LabelObjects1.Caption := 'Objects: ' + IntToStr(ImageEnVect1.ObjectsCount);
{ Are there any objects remaining }
if ImageEnVect1.ObjectsCount > 0 then
begin
{ Select the first object on the current layer }
ImageEnVect1.AddSelObject(0);
ImageEnVect1.Update;
end;
if ImageEnVect1.ObjectsCount < 1 then
begin
LabelObjectStart1.Caption := 'Object Start:';
LabelObjectEnd1.Caption := 'Object End:';
LabelLineStart1.Caption := 'Line Start:';
LabelTextLength1.Caption := 'Text Length:';
LabelTextHeight1.Caption := 'Text Height:';
LabelLineStart1.Caption := 'Line Start:';
LabelLineEnd1.Caption := 'Line End:';
LabelLineLength1.Caption := 'Line Length:';
end;
end;
procedure TForm1.RemoveObject1Click(Sender: TObject);
{ Remove selected objects. }
var
i: Integer;
ihObj: Integer;
begin
for i := ImageEnVect1.SelObjectsCount - 1 downto 0 do
begin
ihObj := ImageEnVect1.SelObjects[i];
ImageEnVect1.RemoveObject(ihObj);
end;
if ihObj > 0 then
LabelObject1.Caption := 'Object: ' +
IntToStr(ImageEnVect1.SelObjects[ihObj] + 1)
else
LabelObject1.Caption := 'Object:';
ImageEnVect1.Update;
LabelObjects1.Caption := 'Objects: ' + IntToStr(ImageEnVect1.ObjectsCount);
if ImageEnVect1.ObjectsCount < 1 then
begin
LabelObjectStart1.Caption := 'Object Start:';
LabelObjectEnd1.Caption := 'Object End:';
LabelLineStart1.Caption := 'Line Start:';
LabelTextLength1.Caption := 'Text Length:';
LabelTextHeight1.Caption := 'Text Height:';
LabelLineStart1.Caption := 'Line Start:';
LabelLineEnd1.Caption := 'Line End:';
LabelLineLength1.Caption := 'Line Length:';
end;
end;
end.
William Miller
Adirondack Software & Graphics
Email: w2m@frontiernet.net
EBook: http://www.imageen.com/ebook/
Apprehend: http://www.frontiernet.net/~w2m/index.html |
|
|
|
Uwe
284 Posts |
Posted - Jan 15 2014 : 09:15:38
|
Hi Bill
Thanks for taking the time to post the code. I'm sure that many of us will appreciate that.
Maybe Nigel should allow zipped attachments in the future as well - in addition to images.
-Uwe |
|
|
|
w2m
USA
1990 Posts |
Posted - Jan 15 2014 : 12:30:57
|
Uwe... I agree. Allowing positing zip files for project demos would save a lot of work. I do not know if the forum html would support that though.
William Miller |
|
|
|
Uwe
284 Posts |
Posted - Jan 16 2014 : 12:26:18
|
Nigel, what do you think?
Thx
-Uwe |
|
|
|
xequte
39066 Posts |
Posted - Jan 16 2014 : 12:28:57
|
Hi
I'm afraid it does not support it directly, but you can:
1. Click attach photo to post
2. Browse to the zip
3. Change the [img] link to [url] links
Not very obvious, I'm afraid.
Nigel
Xequte Software
www.xequte.com
nigel@xequte.com
|
|
|
| |
Topic |
|
Search
Bearing and Distance
