Drawing/Saving/Rotating polygon regions on a form - component wanted!

Hello experts!

I'm looking for a component with an IDE design-time editor, which allows one to place (rotated) polygon shapes anywhere on the form. That's basically all! :)


Backround info:
I have a big form covered by a big TImage. The image displays a city map. I have a round shape (TShape) which is placed somewhere on the image by mapping lang/lat to pixel coordinates with a GPS receiver. Now the map has certain areas of interest highlighted.

I figured, easiest way to determine if the object is currently located within a certain area of interest is by placing fixed polygon shapes above the image and checking if the middle of the TShape circle is located within the client aerea of any of the polygon shapes.

Any suggestions are welcome!! (e.g. if there is an even more efficient way to accomplish this task)


Thanks so much!
Jessi
jessicasmithAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Slick812Commented:
hello jessicasmith, , can you give some more information about what you want to do here? I understand about the map and having  circles at points on the map that represent a Known location (like a City, I guess). .  but I do not understand about your  "Polygon", I guess you want to Draw a polygon on the map, that will show a specific  AREA of the map ( like a County or state boundries ), so you will need a way to have an Input for the Points (x  and  y coordinates) of the area that you want to draw. . .   how ever I have NO IDEA what you mean by  " rotated " polygon, i know what rotated means, but not sure how this would be used on a Map. . . . and what would be the center point of the rotation, some polygons are very odd shapes

Since this seems to be Graphics output type of thing, I might use a TPaintBox instead of a TImage, and just draw the circles on the PaintBox canvas for cities
jessicasmithAuthor Commented:
Not quite ;)  Basically, I have to develop a "sightseeing-tourguide" application using GPS tracking to go onboard the tour-bus ...

First of all I have this high-resolution town map. It is made for tourists, so certain "Points of Interest" (like sights, parks, city center, shopping area, etc.) are marked on it. I converted the map from vector format into a BMP image. It has a very high resolution now (about 2500 x 4200 pixel).
I also have a GPS receiver and a GPS VCL component for Delphi so I always have the most recent latitude/logitude coordinates of the bus available.
This thread describes how to convert GPS long/lat coordinates to left/top pixel coordinates:
http://www.experts-exchange.com/Databases/GIS_GPS/Q_21213084.html

> That's what I got so far.

Now all I need is a procedure like "WhereIsTheBus: <SightID>" which will return the number of the "grid area" (I call a Point of Interest a "grid area"). E.g. 5 (meaning, the damn bus is currently residing in grid number 5) or 0 (meaning the bus is currently not located within any marked grid area).

> That's all I need. ;)

Since ... my image is a Bitmap, I will have to do the marking of the grid areas again (right now they just have a different color). Re-marking means: Putting shapes on the image with the same size and form as the original Point of Interest area. Although these pre-defined aeras are all polygons, i could use serverl rectangles to adapt the form of one polygon by simply putting them on top of each other. But I need to be able to ROTATE them (streets are not always 0/90/180 deg.). Still with me? Just some weired-shaped spots on the BMP I need to "flag" somehow..

Since ... our clients need to be able to update the map with new points of interest themselfes, I need at have at least some kind of GUI to draw the shapes. Or: A textfile to enter top/left/button/right coordinates for every new shape will NOT be enough. But the Delphi IDE will do the job! (They have Delphi and the source available)
So I figured: Either I use the basic TShape object to re-mark the grid areas or I get some neat component which supports polygons/rotating shapes/etc. instead of the TShape.

Since ... the only thing we need to know is the number of the grid area, the tracked bus is located in, I thought we could just use another shape, this time a circle, to represent the bus. A timer in my app will reposition the circle shape every 1-2 sec. automatically. If we are lucky, we have "shape on shape", meaning grid-rect-shape on bus-circle-shape. To find out if we are we could just check, if the middle of the circle-shape is located within the same screen-coordinates as one of the grid-shapes's client area (the area the window-object covers on the screen). This is way every "drawn" shape has to be an instance of a window (with handle and everything) and not a canvas drawing. A canvas drawing has no client area ;)


Again: If there is an easier way, just shoot :D


Kind Regards!                     jessica
Slick812Commented:
????

I tried to follow your explanation above in yout last comment. . . But I could not understand the Rotate idea again, did not get when you said - -

"But I need to be able to ROTATE them (streets are not always 0/90/180 deg.)."

can you explain what you rotate. . . If you give co-ordinates for the polygon as 6 different "Points" (an X and a  Y pixel position on the bitmap) and draw this polygon. . . then what do you need to rotate?. .  I beleive I can do a polygon rotate algorithem, however, I will need to determine what the point od center of rotation is. . .
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Slick812Commented:
I think that you maybe should place all of this in a single component. . . instead of the several TSpapes you say you use. . . Here is a begining component TMapArea  (does NOT have all of the stuff, that you have described in your last comment), but it may or may not be a start for something you can use, It is based on the TPaintBox, but I have added the MapBmp  Bitmap for the background Image -




unit MapArea;

interface

uses
   Windows, SysUtils, Controls, Classes, Graphics;

type

  TRefPoint = record
    Pos: TPoint;
    Width: Integer;
    Color: Cardinal;
    end;

  PAreaPnt = ^TAreaPnt;
  TAreaPnt = record
    Color, Length: Cardinal;
    Points: array[0..0] of TPoint;
    end;

  TMapArea = class(TGraphicControl)
  private
    FOnPaint: TNotifyEvent;
   // property Color;
  protected
    FMapBmp: TBitmap;
    FRefPoints: Array of TRefPoint;
    FAreas: Array of PAreaPnt;
    procedure setBmp(Value: TBitMap);
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
    function AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
    function PointInArea(IndexP, IndexA: Integer): Boolean;
    property Canvas;
  published
    property MapBmp: TBitMap read FMapBmp write setBmp;
    property Align;
    property Anchors;
//    
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnStartDock;
    property OnStartDrag;
  end;


procedure Register;

implementation

//uses Windows, Messages{, SysUtils,} ;


procedure Register;
begin
RegisterComponents('Samples', [TMapArea]);
end;


constructor TMapArea.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 105;
Height := 105;
FMapBmp := TBitMap.Create;
end;

destructor TMapArea.Destroy;
var
i: Integer;
begin
FreeAndNil(FMapBmp);
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
inherited Destroy;
end;

procedure TMapArea.Paint;
var
i, Radi: Integer;
begin
Canvas.Font := Font;
//Canvas.Brush.Color := Color;
if not FMapBmp.Empty then
  begin
  Canvas.Draw(0,0, FMapBmp);
  end else
  if (csDesigning in ComponentState) then
  with Canvas do
    begin
    Pen.Style := psDash;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    end;

for i := 0 to High(FRefPoints) do
  begin
  Canvas.Brush.Color := FRefPoints[i].Color;
  Canvas.Pen.Color := FRefPoints[i].Color;
  Radi := FRefPoints[i].Width div 2;
  Canvas.Ellipse(FRefPoints[i].Pos.X - Radi, FRefPoints[i].Pos.Y - Radi,
                 FRefPoints[i].Pos.X + Radi, FRefPoints[i].Pos.Y + Radi);
  end;


Canvas.Brush.Style := bsClear;
for i := 0 to High(FAreas) do
  begin
  Canvas.Pen.Color := FAreas[i].Color;
  Windows.Polygon(Canvas.Handle, FAreas[i].Points, FAreas[i].Length);
  end;
Canvas.Brush.Color := clWhite;
 
if Assigned(FOnPaint) then FOnPaint(Self);
end;

procedure TMapArea.setBmp(Value: TBitMap);
begin
FMapBmp.Assign(Value);
if not FMapBmp.Empty then
  begin
  Height := FMapBmp.Height;
  Width := FMapBmp.Width;
  end;
Invalidate;
end;

function TMapArea.AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
begin
SetLength(FRefPoints, Length(FRefPoints)+1);
Result := High(FRefPoints);
FRefPoints[Result].Pos.X := X;
FRefPoints[Result].Pos.Y := Y;
if Width < 2 then Width := 2;
FRefPoints[Result].Width := Width;
if Color = clDefault then Color := clRed;
FRefPoints[Result].Color := Cardinal(Color) and $FFFFFF;
end;


function TMapArea.AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
var
len: Integer;
begin
if High(Points) < 2 then Exit;
SetLength(FAreas, Length(FAreas)+1);
Result := High(FAreas);
len := (High(Points)+1)*SizeOf(TPoint);
GetMem(FAreas[Result], len+SizeOf(TPoint));
FAreas[Result].Length := High(Points)+1;
if Color = clDefault then Color := clBlack;
FAreas[Result].Color := Cardinal(Color) and $FFFFFF;
CopyMemory(@FAreas[Result].Points, @Points[0], len);
end;

function TMapArea.PointInArea(IndexP, IndexA: Integer): Boolean;
var
hRgn: THandle;
begin
Result := False;
if (IndexP < 0) or (IndexA < 0) or (IndexP > High(FRefPoints)) or
 (IndexA > High(FAreas)) or (High(FRefPoints) < 0) or (High(FAreas) < 0) then Exit;
hRgn := CreatePolygonRgn(FAreas[IndexA].Points, FAreas[IndexA].Length, WINDING);
if PtInRegion(hRgn, FRefPoints[IndexP].Pos.x, FRefPoints[IndexP].Pos.y) then
  Result := True;
DeleteObject(hRgn);
end;

end.
Slick812Commented:
code to use TMapArea - -


  private
    { Private declarations }
    MapArea1: TMapArea;
    pnt1, pnt2, pnt3, LeftArea, RightArea: Integer;


procedure TFormT2.but_MapAreaClick(Sender: TObject);
var
Bmp1: TBitmap;
aryPnts: Array of TPoint;
begin
if Assigned(MapArea1) then Exit;
MapArea1 := TMapArea.Create(Self);
MapArea1.Parent := Self;
MapArea1.Left := 0;
MapArea1.Top := 0;
Bmp1 := TBitmap.Create;
Bmp1.Canvas.Brush.Color := $33DDDD;
Bmp1.Width := 244;
Bmp1.Height := 244;
MapArea1.MapBmp := Bmp1;
FreeAndNil(Bmp1);
pnt1 := MapArea1.AddRefPoint(140,33,2, clBlue);
pnt2 := MapArea1.AddRefPoint(40,53,8);
pnt3 := MapArea1.AddRefPoint(30,153,6, $DA8CD4);
setlength(aryPnts, 4);
aryPnts[0] := Point(4,5);
aryPnts[1] := Point(74,2);
aryPnts[2] := Point(64,105);
aryPnts[3] := Point(22,80);
LeftArea := MapArea1.AddArea(aryPnts, clWhite);
setlength(aryPnts, 6);
aryPnts[0] := Point(104,9);
aryPnts[1] := Point(174,1);
aryPnts[2] := Point(144,29);
aryPnts[3] := Point(164,90);
aryPnts[4] := Point(142,80);
aryPnts[5] := Point(114,69);
RightArea := MapArea1.AddArea(aryPnts, $AB00F8);
end;


procedure TFormT2.sbut_TestMapAreaClick(Sender: TObject);
begin
if not Assigned(MapArea1) then Exit;
if MapArea1.PointInArea(Pnt2, LeftArea) then
  ShowMessage('Pnt2 is in the Left Area');

if MapArea1.PointInArea(Pnt3, LeftArea) then
  ShowMessage('Pnt3 is in the Left Area');

if MapArea1.PointInArea(pnt1, RightArea) then
  ShowMessage('Pnt1 is in the Right Area');
end;
jessicasmithAuthor Commented:
Dear Slick!

This looks very impressive already!! I implemented it and its just right for the job! As far as I can see, there is only one more thing missing now: The GUI to draw the polygons on the BMP. (please ignore the "polygons have to be rotated" thing, the polygon form is actually flexible enough to mark any of the pre-falgged areas).
Of course a run-time editor would be very nice, so my clients don't need to fire up the IDE everytime they want to edit the grid areas. But as I said, a design-time editor would be "ok" as well. A very handy feature would be having SaveToFile and LoadFromFile commands within the TMapArea component, so the artwork can easily be saved once drawn.
BTW: The areas don't need to have names, rather they should be numbered 1 trou N automatically once added. Ideally the shape-number/tag/ID should be displayed inside the shape so it can be visually identified.

Almost forgot: Since I will now use the MapArea for both - displaying areas and the moving-spot - I will also need a DelRefPoint or even a LocateRefPoint function.

Thanks for your help, Mr. 812, really appreciate it!! :)

Jessica
Slick812Commented:
I guess I will ask, since your last comment is not very clear to me about what you would like, or what you are trying to do, or your "run-time" editor, and save to file and other things. . . Although I did get a "sort of" idea of something you need, a way to create a polygon "Area" by mouse clicks on the MapArea thing. . .
But I am not sure about your overall functioning here. . . It seems that you will have a "Bus User" program, that will be viewed on the Bus, or used by some-one who is tracking the bus movement. . . and I guess they will need to set an area by clicking on the map several times to make a polygon, that is not difficult to do, I would think you could do mouse clicks, but I will do something for that. . .

I have made it so there is a separate procedure called  MoveBus(X, Y )  that will place a small bus (or circle) on the map,

and you say - -

"The areas don't need to have names, rather they should be numbered"

in this the  AddArea( ) function Returns an Index number for the Area , as this code -

LeftArea := MapArea1.AddArea(aryPnts, clWhite);

will set the LeftArea (integer) to the Index number of the Area, used in the  PointInArea( ) function, like -
 MapArea1.PointInArea(Pnt2, LeftArea)


and you say something about a  "SaveToFile" for the Bitmap, if you look at the code you will see that the  FMapBmp  TBitmap is never changed, I just draw in in the Paint procedure and then draw the dots using the  FRefPoints  array on the "Canvas" of the component, not the bitmap, but I can have something that will create a bitmap that has the map bitmap with the rest of the dots and areas drawn on it, and save to file. . .
however I am compleatly baffeled (? ?)  by your request for a Load from file for the Bitmap, it is a regular TBitmap, that already has a "LoadFromFile" procedure, ? ? so what do you mean? ?

Slick812Commented:
here is a new version of the TMapArea, I have added a separate  "Bus"  point, no bus point will be shown until you you do the  MoveBus(X, Y)  procedure, then the bus will show, if the X and Y are on the bitmap. . . you can get the Bus Point by using the BusPosition property. And to see is the Bus is in an Area you use the  BusInArea   function, which will Return a  -1  if it is NOT in an Area, or the Index number of the Area that it is Inside of. . . .  Also the  property FullBus  can be set to False, to get a Circle instead of a little bus

Now for the user Editing of an Area. . . I have added a mouse click for this, , , YOU MUST hold down the  "Ctrl"  key and then click on the MapArea more than twice (keep holding down the Ctrl key for each click), which will draw the new Area, . .  
once you have placed all of your mouse click Area Points (finished), release the Ctrl key (Ctrl key UP) and then you HAVE TO CLICK the MapArea again Without the Ctrl key, and you will be shown a "Yes  No" dialog, incase you have made a misteak, if you click the "Yes" a new Area will be added to the map.

you can set the ShowIndex  to True and it will Paint an  Index Number   inthe center of  all the  Areas



unit MapArea;

interface

uses
   Windows, SysUtils, Controls, Classes, Graphics;

type

  TRefPoint = record
    Pos: TPoint;
    Width: Integer;
    Color: Cardinal;
    end;

  PAreaPnt = ^TAreaPnt;
  TAreaPnt = record
    Color, Length: Cardinal;
    Points: array[Word] of TPoint;
    end;

  TMapArea = class(TGraphicControl)
  private
    FOnPaint: TNotifyEvent;
  protected
    FBusPnt: TPoint;
    FMapBmp: TBitmap;
    FFullBus, FNewA, FShowIn: Boolean;
    FRefPoints: Array of TRefPoint;
    FAreas: Array of PAreaPnt;
    FNewPnts: Array of TPoint;
    procedure setBmp(Value: TBitMap);
    procedure setFull(Value: Boolean);
    procedure SetShowIn(Value: Boolean);
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MoveBus(X, Y: Integer);
    function AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
    procedure ClearRefPoints;
    function AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
    procedure ClearAreas;
    function PointInArea(IndexP, IndexA: Integer): Boolean;
    function BusInArea: Integer;
    property Canvas;
  published
    property MapBmp: TBitMap read FMapBmp write setBmp;
    property FullBus: Boolean read FFullBus write SetFull default True;
    property ShowIndex: Boolean read FShowIn write SetShowIn default False;
    property BusPosition: TPoint read FBusPnt;
    property Align;
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnStartDock;
    property OnStartDrag;
  end;


procedure Register;

implementation

uses Math, Dialogs;

procedure Register;
begin
RegisterComponents('Samples', [TMapArea]);
end;


constructor TMapArea.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 105;
Height := 105;
FMapBmp := TBitMap.Create;
FBusPnt.x := MaxInt;
FFullBus := True;
FNewA := False;
end;

destructor TMapArea.Destroy;
var
i: Integer;
begin
FreeAndNil(FMapBmp);
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
inherited Destroy;
end;

procedure TMapArea.Paint;
var
i, j, Radi: Integer;
Rect1: TRect;
begin
Canvas.Font := Font;
if not FMapBmp.Empty then
  begin
  Canvas.Draw(0,0, FMapBmp);
  end else
  if (csDesigning in ComponentState) then
  with Canvas do
    begin
    Pen.Style := psDash;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    end;

for i := 0 to High(FRefPoints) do
  begin
  Canvas.Brush.Color := FRefPoints[i].Color;
  Canvas.Pen.Color := FRefPoints[i].Color;
  Radi := FRefPoints[i].Width div 2;
  Canvas.Ellipse(FRefPoints[i].Pos.X - Radi, FRefPoints[i].Pos.Y - Radi,
                 FRefPoints[i].Pos.X + Radi, FRefPoints[i].Pos.Y + Radi);
  end;


Canvas.Brush.Style := bsClear;
SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT));
for i := 0 to High(FAreas) do
  begin
  Canvas.Pen.Color := FAreas[i].Color;
  Windows.Polygon(Canvas.Handle, FAreas[i].Points, FAreas[i].Length);
  if FShowIn then
    begin
    Rect1 := Rect(2000,2000, -2000, -2000);
    for j := 0 to FAreas[i].Length-1 do
      begin
      Rect1.Left := Min(Rect1.Left, FAreas[i].Points[j].x);
      Rect1.Top := Min(Rect1.Top, FAreas[i].Points[j].y);
      Rect1.Right := Max(Rect1.Right, FAreas[i].Points[j].x);
      Rect1.Bottom := Max(Rect1.Bottom, FAreas[i].Points[j].y);
      end;
    Rect1.Left := Rect1.Left+((Rect1.Right - Rect1.Left) shr 1);
    Rect1.Top := Rect1.Top+((Rect1.Bottom - Rect1.Top) shr 1);
    Canvas.TextOut(Rect1.Left-3, Rect1.Top-6, IntToStr(i));
    end;
  end;
 
if FBusPnt.x <> MaxInt then
  with Canvas do
  begin
  if FFullBus then
    begin
    Pen.Color := $A0A0A0;
    Brush.Style := bsSolid;
    Brush.Color := $B9B0B0;
    RoundRect(FBusPnt.x -14, FBusPnt.y - 5, FBusPnt.x +14, FBusPnt.y + 5,4,4);
    Brush.Color := clBlack;
    Pen.Color := clBlack;
    Ellipse(FBusPnt.x -11, FBusPnt.y +2, FBusPnt.x -7, FBusPnt.y + 8);
    Ellipse(FBusPnt.x +7, FBusPnt.y + 2, FBusPnt.x +11, FBusPnt.y + 8);
    Pen.Color := $B9B0B0;
    MoveTo(FBusPnt.x -11, FBusPnt.y +2);
    LineTo(FBusPnt.x +11, FBusPnt.y +2);
    Brush.Color := $505080;
    Pen.Color := $606060;
    Rectangle(FBusPnt.x -12, FBusPnt.y - 4, FBusPnt.x -9, FBusPnt.y);
    Rectangle(FBusPnt.x -7, FBusPnt.y - 4, FBusPnt.x -5, FBusPnt.y);
    Rectangle(FBusPnt.x -3, FBusPnt.y - 4, FBusPnt.x-1, FBusPnt.y);
    Rectangle(FBusPnt.x +1, FBusPnt.y - 4, FBusPnt.x+3, FBusPnt.y);
    Rectangle(FBusPnt.x +1, FBusPnt.y - 4, FBusPnt.x+3, FBusPnt.y);
    Rectangle(FBusPnt.x +5, FBusPnt.y - 4, FBusPnt.x+7, FBusPnt.y);
    Rectangle(FBusPnt.x +9, FBusPnt.y - 4, FBusPnt.x+11, FBusPnt.y);
    end else
    begin
    Brush.Color := clWhite;
    Pen.Color := clBlack;
    Ellipse(FBusPnt.x -7, FBusPnt.y -7, FBusPnt.x +7, FBusPnt.y + 7);
    Brush.Color := clBlack;
    Ellipse(FBusPnt.x -3, FBusPnt.y - 3, FBusPnt.x +3, FBusPnt.y + 3);
    end;
  end;
Canvas.Brush.Color := clWhite;
 
if Assigned(FOnPaint) then FOnPaint(Self);
end;

procedure TMapArea.setBmp(Value: TBitMap);
begin
FMapBmp.Assign(Value);
if not FMapBmp.Empty then
  begin
  Height := FMapBmp.Height;
  Width := FMapBmp.Width;
  end;
Invalidate;
end;

function TMapArea.AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
begin
SetLength(FRefPoints, Length(FRefPoints)+1);
Result := High(FRefPoints);
FRefPoints[Result].Pos.X := X;
FRefPoints[Result].Pos.Y := Y;
if Width < 2 then Width := 2;
FRefPoints[Result].Width := Width;
if Color = clDefault then Color := clRed;
FRefPoints[Result].Color := Cardinal(Color) and $FFFFFF;
Paint;
end;


function TMapArea.AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
var
len: Integer;
begin
Result := -1;
if High(Points) < 2 then Exit;
SetLength(FAreas, Length(FAreas)+1);
Result := High(FAreas);
len := (High(Points)+1)*SizeOf(TPoint);
GetMem(FAreas[Result], len+SizeOf(TPoint));
FAreas[Result].Length := High(Points)+1;
if Color = clDefault then Color := clBlack;
FAreas[Result].Color := Cardinal(Color) and $FFFFFF;
CopyMemory(@FAreas[Result].Points, @Points[0], len);
Paint;
end;

function TMapArea.PointInArea(IndexP, IndexA: Integer): Boolean;
var
hRgn: THandle;
begin
Result := False;
if (IndexP < 0) or (IndexA < 0) or (IndexP > High(FRefPoints)) or
 (IndexA > High(FAreas)) or (High(FRefPoints) < 0) or (High(FAreas) < 0) then Exit;
hRgn := CreatePolygonRgn(FAreas[IndexA].Points, FAreas[IndexA].Length, WINDING);
if PtInRegion(hRgn, FRefPoints[IndexP].Pos.x, FRefPoints[IndexP].Pos.y) then
  Result := True;
DeleteObject(hRgn);
end;

procedure TMapArea.MoveBus(X, Y: Integer);
begin
FBusPnt.x := X;
FBusPnt.y := Y;
Paint;
end;

procedure TMapArea.setFull(Value: Boolean);
begin
if Value = FFullBus then Exit;
FFullBus := Value;
if FBusPnt.x <> MaxInt then
  Paint;
end;

procedure TMapArea.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
with Canvas do
if (Button = mbLeft) AND (ssCtrl in Shift) then
  begin
  FNewA := True;
  SetLength(FNewPnts, Length(FNewPnts)+1);
  FNewPnts[High(FNewPnts)].x := X;
  FNewPnts[High(FNewPnts)].y := Y;
  Brush.Color := clRed;
  Pen.Color := $B0B000;
  Ellipse(X -4, Y -4, X +4, Y + 4);
  if High(FNewPnts) > 0 then
    begin
    Pen.Color := 0;
    MoveTo(FNewPnts[High(FNewPnts)].x, FNewPnts[High(FNewPnts)].y);
    LineTo(FNewPnts[High(FNewPnts)-1].x, FNewPnts[High(FNewPnts)-1].y);
    end;
  end else
  if FNewA then
  begin
  FNewA := False;
  if Length(FNewPnts) > 2 then
    if MessageDlg('Do you want to use the current Points to make a New Area?',
                  mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      AddArea(FNewPnts) else
      Paint;
  SetLength(FNewPnts, 0);
  end;
end;

function TMapArea.BusInArea: Integer;
var
i: Integer;
hRgn: THandle;
begin
Result := -1;
if FBusPnt.x = MaxInt then Exit;
for i := 0 to High(FAreas) do
  begin
  hRgn := CreatePolygonRgn(FAreas[i].Points, FAreas[i].Length, WINDING);
  if PtInRegion(hRgn, FBusPnt.x, FBusPnt.y) then
    begin
    Result := i;
    DeleteObject(hRgn);
    Break;
    end;
  DeleteObject(hRgn);
  end;
end;

procedure TMapArea.SetShowIn(Value: Boolean);
begin
if FShowIn = Value then Exit;
FShowIn := Value;
Paint;
end;

procedure TMapArea.ClearRefPoints;
begin
SetLength(FRefPoints, 0);
Paint;
end;

procedure TMapArea.ClearAreas;
var
i: Integer;
begin
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
SetLength(FRefPoints, 0);
Paint;
end;

end.
jessicasmithAuthor Commented:
Ok, again, very nice work! It covers 99% of my demands now!

To get the picture, I'll give you some more infos on the scenario the software will be used in:
My company is supposed to develop a software which will automatically playback video-sequences inside a historical bus trolley (e.g.: bus reaches the town hall, app will notice this and start playing back the townhall.avi). In the bus there will be a PC with 2 screens hooked up running both, the tracking-program you have been helping me out with and the player-program which will communicate with the tracking app (e.g. "ask" if the bus is in a new region) and play a new AVI seq if neccerssary. My company also creates the content for the tour (film, audio, etc, etc.) and is supposed to install and test the whole system. After that, the client is basically "on hes own", meaning whenever something has to be change (e.g. there is a new grid area or some AVI has to be replaced) he has to take care of that himself. This is way the app needs to have a GUI to draw the polygons (the client is not very familiar with computers at all).

So what CAN be changed? Well, thats easy to tell: Map, Areas, AVIs

A "Tour" always has ONE "Map" (in BMP format), UNLIMITED "Areas" (polygons on canvas), and ONE OR MORE "AVIs" corresponding to an area.

E.g.: We currently have 17 grid areas. Area 0 is the starting point of the tour. The bus parks at the starting point. Once enough people are on the bus, the tour starts. The app will "realize" that the tour has started once the bus leaves area 0 and enters area 1. Now it will start playing AVI-1 of Area-1. Once the AVI is finnished, it will check if the bus is still located in the same area. If so, it will start playing AVI-2 of Area-1 (of there is more than one AVI file set for the area). If there is only one AVI file and the bus is still in the same area, a Buffer-AVI will start playing to overcome the time-gap until the bus reaches the next area. Let's say Area-1 has only one AVI (AVI-1, which is 1:30 min.). After 1:00 min. the bus leaves Area-1 and enters Area-2 after 1:10 min. from the start. Now AVI-1 is still playing, eventhou the bus is already in Area-2. Now, the app is supposed to finnish playing AVI-1 and start AVI-2 right after AVI-1 is over. Now you can see, why one has to be able to assign more than one AVI to the same area: If there is a "drawback" - like the scenario i just outlined (bus in Area-2 but still playing Area-1 video) - part of the AVIs can be skipped. Every time a new AVI seq starts, the app can check if the region is still the same and - if it is not - can stop playing the content for this region. Still with me?

.. How to load/save a map-image (BMP) into the TMapArea is clear. (You did this in your first example already)

.. How to load/save canvas drawings from/to disc is not. Imagine my client drawing 17 areas with your neat mouse-drawing function, than after one day he closes the app. All his work will be lost. I was going to give a seperate program to our client with which he could edit the map areas. It should use the same component as the app that displays them. This program should just support loading a bitmap (I know how to do this), load+alter draw grid areas OR(!!!) draw a whole new grid, and save the work to a file. So basically this will be a tour-editor to edit/create tour routes.

.. The final tour-editor must also have the functionality to add one or more AVI seq to every grid area. I think I can handle this one myself (might also post another question for that, but I have coded a similar routine before).

Again: The other app, the "bus-location-server" has only two I/O functions:

1) Load a tour created with the tour-editor app.
2) Return current grid as integer when asked. (The grid ID, the bus currently is located in - if any)


After all this is done, I will start with app nr. 3 - the tour player. So in the end it will be Server - Editor - Player.



Hope this gives you a picture ;) Actually, the only thing thats left now is the load/save function to store/retrieve the canvas drawings to/from the harddrive.

Again, thanks so much for your efforts!

Jessica

BTW: Your lil' bus icon .. nice bonus feature! ;)
Sergio_HdezCommented:
I see you have almost all working, but I guess it can be done pretty much simplier as I see it.

You have a big picture with the map, and need to detect when the bus comes into one area or another AND, very important, let the final user change those areas easily... my idea is to have two images, one is the map, and the other is a white one with the zones just drawed in a different color each one. Then, to know if the bus is in a zone, take its coordinates on the map picture (x,y), and read the colour it has on the areas picture using "PictureArea.BitMap.Pixel(x,y)" and compare it with a list of colors.

For instance, you create a const Color: array[1..30] of TColor = (clRed, clLime, etc.); then, you only need to  loop on that list comparing color of the pixel in the secondary bitmap (the one with the areas drawn in) and thats all:

function GimmeTheZone(x,y: Integer);
begin
  result:= 0; //No zone found by default
  for i:= Low(Color) to High(Color) do begin
    if PictureArea.BitMap.Pixel(x,y) = Color[i] then begin
      result:= i;
      break;
    end;
  end;
end;

This function is fast for the purpouse you need them, and the best thing is that you can let the user draw in the picture just by letting him pick up a color from the list and changing pixel(x,y) as he moves the mouse over the map... easy!

You could also paint both pictures one over the other just using some kind of overlaying... for instance, make a pixel by pixel sum of both, using map colour if area picture is white, and an average of the two colors in other case, so zones will "tint" the map in a color. Save this merged picture to show it on screen instead of the map picture.

I hope this approach simplifies your code!
jessicasmithAuthor Commented:
Dear Sergio:

Thanks very much for your efforts to find a differnet approach to accomplish this task. Sounds logical to me: Since I already have a pixel-grid (the BMP itself) why not do the matching also with pixels rather than vector shapes.

Only thing is: Slick's solution is already 99% working for me and it seems to be very fast.

Since I have to scroll one very large bitmap already (the map, witch is like 3500 x 4500 pixel) I'm not sure if the GFX-card could as well handle two bitmaps of that size. (especially if both are colored.. they will be like 100MB combined).

So let's try to base the solution on the code listed above.

Best Regards,
Jessica
Slick812Commented:
I have added some more stuff to the TMapArea -
and Event that will fire if you Draw and ADD a new Area to the Map, "OnAddArea" event as type -

TAddAreaEvent = procedure(Sender: TObject; Index: Integer) of Object; // Index is the Area Index Added

you can use this event to add AVI files to an array of file names for each area index

 - - - - -
     procedure ClearRefPoints;
whch will Delete all of the Reference Points

- - - - - - - - -
     procedure ClearAreas;
which will Delete ALL of the Areas

- - - - - - - - - -
     function DeleteArea(Index: Integer): Boolean;
this will delete and Area by it's Index, but be WARNED! !, the Area Index numbers above that Index will be MOVED lower and you will need to reasign those Index numbers. . .

- - - - - - - - - -
     procedure SaveToFile(const FileName: String);
     procedure SaveToStream(Stream: TStream);
these will save a mapArea file with the Dot Array and the Area Array, and the Map Bitmap to a File (or stream)

- - - - - - - - - - - - - - -
     procedure LoadFromFile(const FileName: string);
     procedure LoadFromStream(Stream: TStream);
these will load a MapArea File or stream


- - - - - - - - - - - -
     procedure MoveBus(X, Y: Integer; East: Boolean = True);
this has been CHanged. .  the East has been added, to show the icon bus going right (True) or left (False)
Slick812Commented:
unit MapArea;

interface

uses
   Windows, Controls, Classes, Graphics;

type

  PRefPoint = ^TRefPoint;
  TRefPoint = record
    Pos: TPoint;
    Width: Integer;
    Color: Cardinal;
    end;

  PAreaPnt = ^TAreaPnt;
  TAreaPnt = record
    Length, Color: Cardinal;
    Points: array[Word] of TPoint;
    end;

  TAddAreaEvent = procedure(Sender: TObject; Index: Integer) of Object;

  TMapArea = class(TGraphicControl)
  private

  protected
    FOnPaint: TNotifyEvent;
    FOnAddArea: TAddAreaEvent;
    FBusPnt: TPoint;
    FMapBmp: TBitmap;
    FFullBus, FNewA, FShowIn, FEast: Boolean;
    FRefPoints: Array of TRefPoint;
    FAreas: Array of PAreaPnt;
    FNewPnts: Array of TPoint;
    procedure setBmp(Value: TBitMap);
    procedure setFull(Value: Boolean);
    procedure SetShowIn(Value: Boolean);
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure AssignTo(Dest: TPersistent); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure MoveBus(X, Y: Integer; East: Boolean = True);
    function AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
    procedure ClearRefPoints;
    function AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
    procedure ClearAreas;
    function DeleteArea(Index: Integer): Boolean;
    function PointInArea(IndexP, IndexA: Integer): Boolean;
    function BusInArea: Integer;
    procedure SaveToFile(const FileName: String);
    procedure SaveToStream(Stream: TStream);
    procedure LoadFromFile(const FileName: string);
    procedure LoadFromStream(Stream: TStream);
    property Canvas;
  published
    property MapBmp: TBitMap read FMapBmp write setBmp;
    property FullBus: Boolean read FFullBus write SetFull default True;
    property ShowIndex: Boolean read FShowIn write SetShowIn default False;
    property BusPosition: TPoint read FBusPnt;
    property Align;
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnAddArea: TAddAreaEvent read FOnAddArea write FOnAddArea;
    property OnStartDock;
    property OnStartDrag;
  end;


procedure Register;

implementation

uses Math, SysUtils, Dialogs;

const
FileID: Integer = 274639101;

procedure Register;
begin
RegisterComponents('Samples', [TMapArea]);
end;


constructor TMapArea.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];
Width := 105;
Height := 105;
FMapBmp := TBitMap.Create;
FBusPnt.x := MaxInt;
FFullBus := True;
FNewA := False;
FShowIn := False;
FEast := True;
end;

destructor TMapArea.Destroy;
var
i: Integer;
begin
FreeAndNil(FMapBmp);
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
inherited Destroy;
end;

procedure TMapArea.Paint;
var
i, j, Radi: Integer;
Rect1: TRect;
penC, brushC: TColor;
begin
Canvas.Font := Font;
penC := Canvas.Pen.Color;
brushC := Canvas.Brush.Color;
if not FMapBmp.Empty then
  begin
  Canvas.Draw(0,0, FMapBmp);
  end else
  if (csDesigning in ComponentState) then
  with Canvas do
    begin
    Pen.Style := psDash;
    Brush.Style := bsClear;
    Rectangle(0, 0, Width, Height);
    Exit;
    end;

for i := 0 to High(FRefPoints) do
  with Canvas do
  begin
  Brush.Color := FRefPoints[i].Color;
  Pen.Color := FRefPoints[i].Color;
  Radi := FRefPoints[i].Width div 2;
  Ellipse(FRefPoints[i].Pos.X - Radi, FRefPoints[i].Pos.Y - Radi,
                 FRefPoints[i].Pos.X + Radi, FRefPoints[i].Pos.Y + Radi);
  end;


Canvas.Brush.Style := bsClear;
SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT));
for i := 0 to High(FAreas) do
  begin
  Canvas.Pen.Color := FAreas[i].Color;
  Windows.Polygon(Canvas.Handle, FAreas[i].Points, FAreas[i].Length);
  if FShowIn then
    begin
    Rect1 := Rect(2000,2000, -2000, -2000);
    for j := 0 to FAreas[i].Length-1 do
      begin
      Rect1.Left := Min(Rect1.Left, FAreas[i].Points[j].x);
      Rect1.Top := Min(Rect1.Top, FAreas[i].Points[j].y);
      Rect1.Right := Max(Rect1.Right, FAreas[i].Points[j].x);
      Rect1.Bottom := Max(Rect1.Bottom, FAreas[i].Points[j].y);
      end;
    Rect1.Left := Rect1.Left+((Rect1.Right - Rect1.Left) shr 1);
    Rect1.Top := Rect1.Top+((Rect1.Bottom - Rect1.Top) shr 1);
    Canvas.TextOut(Rect1.Left-3, Rect1.Top-6, IntToStr(i));
    end;
  end;
 
if FBusPnt.x <> MaxInt then
  with Canvas do
  begin
  if FFullBus then
    begin
    Pen.Color := $A0A0A0;
    Brush.Style := bsSolid;
    Brush.Color := $B9B0B0;
    RoundRect(FBusPnt.x -16, FBusPnt.y - 5, FBusPnt.x +16, FBusPnt.y + 5,4,4);
    Brush.Color := clBlack;
    Pen.Color := clBlack;
    Ellipse(FBusPnt.x -12, FBusPnt.y +2, FBusPnt.x -8, FBusPnt.y + 7);
    Ellipse(FBusPnt.x +8, FBusPnt.y + 2, FBusPnt.x +12, FBusPnt.y + 7);
    Pen.Color := $B9B0B0;
    MoveTo(FBusPnt.x -11, FBusPnt.y +2);
    LineTo(FBusPnt.x +11, FBusPnt.y +2);

    Brush.Color := $608490;
    Pen.Color := $707880;
    if FEast then
      Rectangle(FBusPnt.x +11, FBusPnt.y - 4, FBusPnt.x +16, FBusPnt.y)
      else
      Rectangle(FBusPnt.x -16, FBusPnt.y - 4, FBusPnt.x -11, FBusPnt.y);

    Rectangle(FBusPnt.x -9, FBusPnt.y - 3, FBusPnt.x -7, FBusPnt.y);
    Rectangle(FBusPnt.x -5, FBusPnt.y - 3, FBusPnt.x-3, FBusPnt.y);
    Rectangle(FBusPnt.x-1, FBusPnt.y - 3, FBusPnt.x+1, FBusPnt.y);
    Rectangle(FBusPnt.x +3, FBusPnt.y - 3, FBusPnt.x+5, FBusPnt.y);
    Rectangle(FBusPnt.x +7, FBusPnt.y - 3, FBusPnt.x+9, FBusPnt.y);
    Pen.Color := $FFE4E4;
    MoveTo(FBusPnt.x -13, FBusPnt.y);
    LineTo(FBusPnt.x +13, FBusPnt.y);
    MoveTo(FBusPnt.x -16, FBusPnt.y-5);
    LineTo(FBusPnt.x -16, FBusPnt.y-4);
    end else
    begin
    Brush.Color := clWhite;
    Pen.Color := clBlack;
    Ellipse(FBusPnt.x -7, FBusPnt.y -7, FBusPnt.x +7, FBusPnt.y + 7);
    Brush.Color := clBlack;
    Ellipse(FBusPnt.x -3, FBusPnt.y - 3, FBusPnt.x +3, FBusPnt.y + 3);
    end;
  end;
Canvas.Brush.Color := brushC;
Canvas.Pen.Color := penC;
if Assigned(FOnPaint) then FOnPaint(Self);
end;

procedure TMapArea.setBmp(Value: TBitMap);
begin
FMapBmp.Assign(Value);
if not FMapBmp.Empty then
  begin
  Height := FMapBmp.Height;
  Width := FMapBmp.Width;
  end;
Invalidate;
end;

function TMapArea.AddRefPoint(X, Y, Width: Integer; Color: TColor = clRed): Integer;
begin
SetLength(FRefPoints, Length(FRefPoints)+1);
Result := High(FRefPoints);
FRefPoints[Result].Pos.X := X;
FRefPoints[Result].Pos.Y := Y;
if Width < 2 then Width := 2;
FRefPoints[Result].Width := Width;
if Color = clDefault then Color := clRed;
FRefPoints[Result].Color := Cardinal(Color) and $FFFFFF;
Paint;
end;


function TMapArea.AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
var
len: Integer;
begin
Result := -1;
if High(Points) < 2 then Exit;
SetLength(FAreas, Length(FAreas)+1);
Result := High(FAreas);
len := (High(Points)+1)*SizeOf(TPoint);
GetMem(FAreas[Result], len+SizeOf(TPoint));
FAreas[Result].Length := High(Points)+1;
if Color = clDefault then Color := clBlack;
FAreas[Result].Color := Cardinal(Color) and $FFFFFF;
CopyMemory(@FAreas[Result].Points, @Points[0], len);
Paint;
end;

function TMapArea.PointInArea(IndexP, IndexA: Integer): Boolean;
var
hRgn: THandle;
begin
Result := False;
if (IndexP < 0) or (IndexA < 0) or (IndexP > High(FRefPoints)) or
 (IndexA > High(FAreas)) or (High(FRefPoints) < 0) or (High(FAreas) < 0) then Exit;
hRgn := CreatePolygonRgn(FAreas[IndexA].Points, FAreas[IndexA].Length, WINDING);
if PtInRegion(hRgn, FRefPoints[IndexP].Pos.x, FRefPoints[IndexP].Pos.y) then
  Result := True;
DeleteObject(hRgn);
end;

procedure TMapArea.MoveBus(X, Y: Integer; East: Boolean = True);
begin
FBusPnt.x := X;
FBusPnt.y := Y;
FEast := East;
Paint;
end;

procedure TMapArea.setFull(Value: Boolean);
begin
if Value = FFullBus then Exit;
FFullBus := Value;
if FBusPnt.x <> MaxInt then
  Paint;
end;

procedure TMapArea.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
Re: Integer;
begin
inherited MouseDown(Button, Shift, X, Y);
with Canvas do
if (Button = mbLeft) AND (ssCtrl in Shift) then
  begin
  FNewA := True;
  SetLength(FNewPnts, Length(FNewPnts)+1);
  FNewPnts[High(FNewPnts)].x := X;
  FNewPnts[High(FNewPnts)].y := Y;
  Brush.Color := clRed;
  Pen.Color := $B0B000;
  Ellipse(X -4, Y -4, X +4, Y + 4);
  if High(FNewPnts) > 0 then
    begin
    Pen.Color := 0;
    MoveTo(FNewPnts[High(FNewPnts)].x, FNewPnts[High(FNewPnts)].y);
    LineTo(FNewPnts[High(FNewPnts)-1].x, FNewPnts[High(FNewPnts)-1].y);
    end;
  end else
  if FNewA then
  begin
  FNewA := False;
  if Length(FNewPnts) > 2 then
    if MessageDlg('Do you want to use the current Points to make a New Area?',
                  mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      begin
      Re := AddArea(FNewPnts);
      if Assigned(FOnAddArea) then
        FOnAddArea(Self, Re);
      end else
      Paint;
  SetLength(FNewPnts, 0);
  end;
end;

function TMapArea.BusInArea: Integer;
var
i: Integer;
hRgn: THandle;
begin
Result := -1;
if FBusPnt.x = MaxInt then Exit;
for i := 0 to High(FAreas) do
  begin
  hRgn := CreatePolygonRgn(FAreas[i].Points, FAreas[i].Length, WINDING);
  if PtInRegion(hRgn, FBusPnt.x, FBusPnt.y) then
    begin
    Result := i;
    DeleteObject(hRgn);
    Break;
    end;
  DeleteObject(hRgn);
  end;
end;

procedure TMapArea.SetShowIn(Value: Boolean);
begin
if FShowIn = Value then Exit;
FShowIn := Value;
Paint;
end;

procedure TMapArea.ClearRefPoints;
begin
SetLength(FRefPoints, 0);
Paint;
end;

procedure TMapArea.ClearAreas;
var
i: Integer;
begin
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
SetLength(FAreas, 0);
Paint;
end;

function TMapArea.DeleteArea(Index: Integer): Boolean;
begin
Result := False;
if (Index < 0) or (Index > High(FAreas)) then Exit;
FreeMem(FAreas[Index]);
if Index < High(FAreas) then
  windows.MoveMemory(@FAreas[Index], @FAreas[Index+1], (High(FAreas)-Index)*4);
SetLength(FAreas, Length(FAreas)-1);
Paint;
end;


procedure TMapArea.SaveToFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmCreate);
try
  SaveToStream(Stream);
  finally
  FreeAndNil(Stream);;
  end;
end;

procedure TMapArea.SaveToStream(Stream: TStream);
var
Len, i: Integer;
memStm: TMemoryStream;
begin
Stream.WriteBuffer(FileID, SizeOf(FileID));
Len := Length(FRefPoints);
Stream.WriteBuffer(Len, SizeOf(Len));
if Len > 0 then
  Stream.WriteBuffer(FRefPoints[0], Len*SizeOf(TRefPoint));
Len := Length(FAreas);
Stream.WriteBuffer(Len, SizeOf(Len));
if Len > 0 then
  for i := 0 to High(FAreas) do
  begin
  Len := (FAreas[i].Length*SizeOf(TPoint))+SizeOf(TPoint);
  Stream.WriteBuffer(FAreas[i]^, Len);
  end;
if FMapBmp.Empty then
  begin
  Len := 0;
  Stream.WriteBuffer(Len, SizeOf(Len));
  end else
  begin
  memStm := TMemoryStream.Create;
  FMapBmp.SaveToStream(memStm);
  Len := memStm.Size;
  Stream.WriteBuffer(Len, SizeOf(Len));
  memStm.Position := 0;
  memStm.SaveToStream(Stream);
  FreeAndNil(memStm);
  end;
end;


procedure TMapArea.LoadFromFile(const FileName: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
  LoadFromStream(Stream);
  finally
  Stream.Free;
  end;
end;

procedure TMapArea.LoadFromStream(Stream: TStream);
var
Len, i: Integer;
memStm: TMemoryStream;
begin
Stream.ReadBuffer(i, SizeOf(i));
if i <> FileID then
  raise Exception.Create('FILE READ ERROR - This is NOT a valid Map Area File');
for i := 0 to High(FAreas) do
  FreeMem(FAreas[i]);
SetLength(FRefPoints, 0);
SetLength(FRefPoints, 0);
DeleteObject(FMapBmp.ReleaseHandle);

Stream.ReadBuffer(Len, SizeOf(Len));
if Len > 0 then
  begin
  SetLength(FRefPoints, Len);
  Stream.ReadBuffer(FRefPoints[0], Len*SizeOf(TRefPoint));
  end;

Stream.ReadBuffer(Len, SizeOf(Len));
if Len > 0 then
  begin
  SetLength(FAreas, Len);
  for i := 0 to High(FAreas) do
    begin
    Stream.ReadBuffer(Len, SizeOf(Len));
    Stream.Seek(-4, soFromCurrent);
    Len := (Len*SizeOf(TPoint))+SizeOf(TPoint);
    GetMem(FAreas[i], len);
    Stream.ReadBuffer(FAreas[i]^, Len);
    end;
  end;

Stream.ReadBuffer(Len, SizeOf(Len));
if Len <> 0 then
  begin
  memStm := TMemoryStream.Create;
  memStm.CopyFrom(Stream, Len);
  memStm.Position := 0;
  FMapBmp.LoadFromStream(memStm);
  FreeAndNil(memStm);
  end;
if not FMapBmp.Empty then
  begin
  Width := FMapBmp.Width;
  Height := FMapBmp.Height;
  end;
FBusPnt.x := MaxInt;
SetLength(FNewPnts, 0);
FNewA := False;
Paint;
end;

procedure TMapArea.AssignTo(Dest: TPersistent);
var
i, len: Integer;
begin
if Dest is TMapArea then
  begin
  with TMapArea(Dest) do
  begin
  FBusPnt:= Self.FBusPnt;
  FMapBmp.Assign(Self.FMapBmp);;
  FFullBus := Self.FFullBus;
  FNewA := Self.FNewA;
  FShowIn := Self.FShowIn;
  FEast := Self.FEast;
  if Length(Self.FRefPoints) > 0 then
    begin
    SetLength(FRefPoints, Length(Self.FRefPoints));
    CopyMemory(@FRefPoints[0], @Self.FRefPoints[0], Length(Self.FRefPoints)* SizeOf(TRefPoint));
    end;

  if Length(Self.FAreas) > 0 then
    begin
    SetLength(FAreas, Length(Self.FAreas));
    for i := 0 to High(FAreas) do
      begin
      len := (Self.FAreas[i].Length * SizeOf(TPoint))+SizeOf(TPoint);
      GetMem(FAreas[i], len);
      CopyMemory(FAreas[0], Self.FAreas[0], len);
      end;
    end;
  end;
  end else inherited Assign(Dest);
end;

end.
Slick812Commented:
to save a MapArea File -

MapArea1.SaveToFile('E:\City1.mapArea');

and to use the   OnAddArea  Event -


type
  TAreaAvi = Record
    Index: Integer;
    aryStr: Array of String;
    end;

  private
    { Private declarations }
    MapArea1: TMapArea;
    aryAreaAvi: array of TAreaAvi;
    aForm: TForm;
    procedure AddArea(Sender: TObject; Index: Integer);
    procedure ButClick(Sender: TObject);

 - - - - - - - - -
// set the event somewhere

MapArea1.OnAddArea := AddArea;

- - - - - - - - - - - - - - - - - - - - -


procedure TFormT2.ButClick(Sender: TObject);
begin
if Not Assigned (aForm) then Exit;
if (Sender is TButton) and ((Sender as TButton).Parent = aForm) then
  begin
  with TOpenDialog.Create(aForm) do
    begin
    if Execute then
      if aForm.Components[3] is TListbox then
        TListbox(aForm.Components[3]).Items.Add(FileName);
    Free;
    end;
  end;
end;


  // this is the OnAddArea Event below
  // this will create a Form and you can add files to a list box with the "Open File" button
  // this will save ALL of the file names in the list box to the aryAreaAvi  array
procedure TFormT2.AddArea(Sender: TObject; Index: Integer);
var
aListBox: TListBox;
mRE, i: Integer;
begin
aForm := TForm.CreateNew(Application);
with aForm do
  begin
  BorderStyle := bsDialog;
  ClientWidth := 450;
  ClientHeight := 320;

  Left := (Screen.Width div 2) - (Width div 2);
  Top := (Screen.Height div 2) - (Height div 2);
  Caption := 'Add Avi Files';
  end;

  with TLabel.Create(aForm) do
    begin
    Name := 'L1';
    Parent := aForm;
    Left := 4;
    Top := 4;
    Caption := 'Pleas Add the tour AVI files for this Area - Index '+IntToStr(Index);
    end;

  with TButton.Create(aForm) do
    begin
    Name := 'OpenFileBut';
    Parent := aForm;
    Caption := 'Open a File';
    Width := 95;
    Top := 29;
    Left := AForm.ClientWidth - 105;
    Default := False;
    OnClick := ButClick;
    end;

  with TButton.Create(aForm) do
    begin
    Name := 'OKBut';
    Parent := aForm;
    Caption := 'O K';
    Width := 56;
    Top := aForm.ClientRect.Bottom-34;
    Left := (AForm.ClientWidth div 2) - 28;
    Default := True;
    ModalResult := mrOk;
    end;

  aListBox :=  TListBox.Create(aForm);
  with aListBox do
    begin
    Parent := aForm;
    Name := 'FileLister';
    Left := 4;
    Top := 26;
    Width := 320;
    Height := 240;
    end;

mRe := aForm.ShowModal;
if mRe = idOK then
  begin
  if aListBox.Items.Count > 0 then
    begin
    SetLength(aryAreaAvi, Length(aryAreaAvi)+1);
    aryAreaAvi[High(aryAreaAvi)].Index := Index;
    SetLength(aryAreaAvi[High(aryAreaAvi)].aryStr, aListBox.Items.Count);
    for i := 0 to aListBox.Items.Count -1 do
      begin
      aryAreaAvi[High(aryAreaAvi)].aryStr[i] := aListBox.Items[i];
      Showmessage(aryAreaAvi[High(aryAreaAvi)].aryStr[i]);
      end;
    end;
  end;
FreeAndNil(aForm);
end;
jessicasmithAuthor Commented:
Again, well done! No problems occured so far. I'll finish my application till friday and will also do some more testing with your component. But looks promising..haven't found a single bug so far.

Will get back to you friday (at latest). Points are yours - that's for sure! ;)

Thanks!

Jessica
jessicasmithAuthor Commented:
Dear Slick,

Sorry I didn't make it on friday! I have almost finished the application now. I have the GPS receiver working and got the map goereferenced. Tried it in my car today - the lil' bus is following my trail! Great work!

Basically, there is only one more issue now:
The bus follows a route, starting and ending at the same point. It sometimes travels roads twice within the same tour.
Our client demands the system to be able to "sense" if the bus came by an area the 1st, 2nd, 3rd, etc. time, so every time new content can be played.

E.g.:
Bus travels on Main Rd. from east to south. AVI1 has to be be played.
Bus travels on Main Rd. from south to east. AVI17 has to be played.

For that, your component needs to be able to return not only one but several integer values, representing ALL areas, the bus is currently located within. Our tour player will "know" which one to pick - so you don't have to worry about that. I just need to be able to return a set of areas - if neccersarry. For that, the BusInArea function could either return an array, stringlist, custom record, etc.

Everything else is just fine! Once the multi-area thingie is done, I'll go ahead and close the Q. You have been a great help - I'd honestly like to thank you for your time and all your efforts!! Take care Slick!

-Jessica
Slick812Commented:
sorry, but I do NOT understand what you ask at all, my mind blanks out for this question? ? ? ? ? ? ? ? ? ? ? ? hubbabubbaduuuhhh ?

"to return not only one but several integer values, representing ALL areas"

this has no meaning to me, the bus is in only  "ONE AREA"  at any specific time ( I have NO CODE to display the bus more than once)

and this certainly sounds like something that you should be programming in your code not something that I should be doing in the component

you might set an Integer variable for each area (or an array of Integers) and each time the bus leaves an area, then increase this Integer, so each time you get the bus area you can read that integer and see if it is the first time, the second time or which time the buss is in that area and then start the movie file index that corresponds to the time (first time) that the bus is in that area
jessicasmithAuthor Commented:
No, no. That's not what I ment.

If there are two or more polygons ("areas") OVERLAPPING each other, I need to get the ID of BOTH/"ALL" areas as return value rather than only the ID of the buttom-most area. You see?

"ALL" not as in "all areas on the canvas" - just all areas BELOW the bus-symbol. For that the return value of BusInArea should become some other datatype which can hold several values.

-Jessica

Slick812Commented:
I did not get any of that from your first comment. . .
You really should NOT have any overlapping areas. . . as in using this with overlapping areas may cause execution errors if a unexpected change occures (externally in the bus route or travel detours. . . or internally in the code you may add for the presentation). . . however, I will look at the code and maybe add something. .  if you are using the same "Area"  of the map more than once (as in making 2 areas that are the same size and shape) that play different avi for the other area, you maybe should differentiate the AVI set (make a second info holder- array - for the AVIs) and not duplicate the Area
Slick812Commented:
here are some changes for the TMapArea. . . .

add this  TAreas to the type section like this -


  TAreas = set of Byte;

  TMapArea = class(TGraphicControl)

 - - - - - - -

change the
function BusInArea: Integer;
to -

    function BusInAreas: TAreas;


and place this new code in the old
function TMapArea.BusInArea: Integer;


function TMapArea.BusInAreas: TAreas;
var
i: Integer;
hRgn: THandle;
begin
Result := [];
if FBusPnt.x = MaxInt then Exit;
for i := 0 to High(FAreas) do
  begin
  hRgn := CreatePolygonRgn(FAreas[i].Points, FAreas[i].Length, WINDING);
  if PtInRegion(hRgn, FBusPnt.x, FBusPnt.y) then
    begin
    if i > 255 then Break;
    Result := Result+[i];
    DeleteObject(hRgn);
    end;
  DeleteObject(hRgn);
  end;
end;



 = = = = = = = = = = = = = = = = = = = =
I think that is all I added to do this -


here is some code tho use it


Areas := MapArea1.BusInAreas;
if Areas = [] then
  ShowMessage('Bus not in any area')
  else
  for i := 255 DownTo 0 do
   if i in Areas then
     case i of
       0: ShowMessage('Bus in Area Zero');
       1: ShowMessage('Bus in Area One');
       2: ShowMessage('Bus in Area Two');
       3..255: ShowMessage('Bus in Area above 2');
       end;


= = = = = = = = = = = = = = = = = =

the   function BusInAreas  now returns a set of area Index numbers, , I used a SET because it is easy to add to, , however the maximum number that can be in a set is 256, so your Areas will now be limited to 256 areas

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Slick812Commented:
you may want to change this also -

function TMapArea.AddArea(const Points: array of TPoint; Color: TColor = clBlack): Integer;
var
len: Integer;
begin
Result := -1;
if (Length(FAreas) > 254) or (High(Points) < 2) then Exit; // added the (Length(FAreas) > 254)
// rest of code is the same
Slick812Commented:
When I realized that you were using a Large Bitmap for your map, and sizing your form to the bitmap, I was surprized ! !
I do not remember you saying here that the map bitmap would be larger than the screen. . .
You seem to set the size of your form to the size of the  TMapArea, larger than the screen, which may not be a good programming practice,
AnyWay. .  I added some code to this TMapArea to make it move the large Map INSIDE the display area of the TMapArea, , so it no longer sets it's width and height to the size of the map Bitmap, you press the Alt key amd drag the map to a new view position. . . that way you can set the TMapArea to Align = clClient, , , and then maximize your form, and be able to see the entire map by moving it around.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.