I'm a member in a team that maintains a quite big inhouse Delphi application. Now we have started to look at mapsupport. And we feel that Googlemap seems to be the best value for the money compared to some map components. The current solution (that is really bad) works by starting Internet Explorer from ShellExecute, load some coordinates in the Googlemap URL. Then Google map display the best direction to drive through the coordinates.
It works, but it can be slow if the the amount of coordinates is higher than say 10. Besides that there seems to big memleaks in IE...
Another option is to use TWebBrowser component instead and load a Googlemap html-file to show the same thing. Yes I know Googlemaps license policy and we are prepared to pay Google the price when the solution is used in reality.
Right now I have registed a API-key for my own site just for test. I also found that it works to load a local html-file. From Javascript I can call GUnload to eliminate the memleaks according Googlemap documentation. As the API-key is bound to a domain or a local-file I guess I have to save a javascriptfile with coordinates and then load it in TWebBrowser for every call to the map. I found this clumsy, but I see no other way... ?
Is there other options to use Googlemaps? I don't know other html-components for Delphi than TWebBrowser due to bad performance and memorymanagement. I would like to use a Mozilla component but it seems to be only for C++.
Comments and advice about this ?
I've wrapped the Google Maps API some time ago.
It's a component that contains a TWebBrowser that loads a local html file that contains some javascript helper functions and sets up a basic Google maps page. The HTML file is embedded into the exe as a resource for easy deployment.
It can use some work, but it has done some nice jobs for me already. It expands on the idea that was posed here:
http://www.stevetrefethen.com/blog/UsingGoogleMapsFromVCLSampleApplication.aspx
I've put a demo executable and sourcecode online here:
http://www.xs4all.nl/~niff/GoogleMaps.zip
On this screenshot I've switched to the Google Earth view:
Here are a few examples of how you can use it:
Center the map to some shithole in the Netherlands, with nicely rounded coordinates:
GoogleMaps1.SetCenter(52,5,True);
Load a KML or KMZ file:
GeoXML := TGGeoXML.Create('http://mywebsite.com/mykml.kmz');
GeoXML.GoogleMaps := GoogleMaps1;
GoogleMaps1.AddOverlay( GeoXML );
Switch to the embedded version of Google Earth, for fast and smooth 3d action:
GoogleMaps1.MapType := MT_SATELLITE_3D;
Keep a list of overlays, and manage it via Delphi structures:
GoogleMaps1.Overlays[2].hide; // hide overlay 2
GoogleMaps1.RemoveOverlayByIndex(3); // delete overlay 3
It lets you create polygons using fast Delphi arrays and then plot that in GMaps;
MyPolygon := TGPolygon.Create(MyPointArray);
MyPolygon.Color := clBlue;
MyPolygon.Name := 'Awesome Polygon 1';
GoogleMaps1.AddPolygon( MyPolygon );
It doesn't intend to wrap the full API; it's just to make life easier when dealing with Google maps.
The unit DouglasPeuckers is not really needed. It's used to simplify a polygon when you run out of resources.
Good luck, and let me know if you've created something useful with it.
{—————————————————————————————————————————————————————————————————————————}
{ Project : uGoogleMaps.pas }
{ Comment : Google Maps API wrapper }
{ }
{ Date : 14 mrt 2008 }
{ Author : Wouter van Nifterick }
{—————————————————————————————————————————————————————————————————————————}
{ The aim of this unit is to wrap the Google Maps API in such a way that }
{ users don't need to know that map operations end up being rendered by }
{ a browser component and JavaScript. }
{ }
{ JavaScript classes have a Delphi counterpart, and each Delphi class }
{ takes care of proper JavaScript rendering and execution. }
{ }
{ For many things, like constructing detailed polygons, this provides a }
{ major performance boost and adds compile-time type checking. }
{ }
{ A big limitation so far is that I didn't find a way to directly pass }
{ complex types from and to the JavaScript engine in IE via COM, so for }
{ now, everything needs to be (de)serialized to and from strings. :( }
{—————————————————————————————————————————————————————————————————————————}
{ Last modified }
{ Date : }
{ Author : }
{—————————————————————————————————————————————————————————————————————————}
{$M+}
unit uGoogleMaps;
interface
uses
Controls,
Dialogs,
ActiveX,
StdCtrls,
ExtCtrls,
SysUtils,
Classes,
Contnrs,
Forms,
SHDocVw,
MSHTML,
StrUtils,
DouglasPeuckers
// , uGoogleEarth_intf
;
const
GoogleMapsFileName = 'GoogleMaps.html';
WGS84_MULT_FACT = 100000; // multiply lat/lon values by this value in order to fit them into integers
DEFAULT_SIMPLIFY_TOLERANCE = 0.5;
{$R GoogleMaps_html.res}
type
TGoogleMapControl = (MC_NONE=1,MC_SMALL,MC_LARGE);
TGoogleMapType = (MT_NORMAL=1,MT_SATELLITE,MT_HYBRID,MT_PHYSICAL,MT_SATELLITE_3D);
TGoogleMaps = class; // forward declaration
GIcon = class end; // to be implemented
IJsClassWrapper=interface(IInterface)
function JsClassName:String;
function GetJsVarName:String;
procedure SetJsVarName(const aVarName:String);
property JsVarName:String read GetJsVarName write SetJsVarName;
function ToJavaScript:String;
end;
IHidable=interface(IInterface)
procedure hide; // Hides the object if the overlay is both currently visible and the overlay's supportsHide() method returns true. Note that this method will trigger the respective visibilitychanged event for each child overlay that fires that event (e.g. GMarker.visibilitychanged, GGroundOverlay.visibilitychanged, etc.). If no overlays are currently visible that return supportsHide() as true, this method has no effect. (Since 2.87)
function isHidden : Boolean; // Returns true if the GGeoXml object is currently hidden, as changed by the GGeoXml.hide() method. Otherwise returns false. (Since 2.87)
procedure show; // Shows the child overlays created by the GGeoXml object, if they are currently hidden. Note that this method will trigger the respective visibilitychanged event for each child overlay that fires that event (e.g. GMarker.visibilitychanged, GGroundOverlay.visibilitychanged). (Since 2.87)
function supportsHide : Boolean; //
end;
// marker class
GMarkerOptions=record
icon : GIcon; // Chooses the Icon for this class. If not specified, G_DEFAULT_ICON is used. (Since 2.50)
dragCrossMove : Boolean; // When dragging markers normally, the marker floats up and away from the cursor. Setting this value to true keeps the marker underneath the cursor, and moves the cross downwards instead. The default value for this option is false. (Since 2.63)
title : String; // This string will appear as tooltip on the marker, i.e. it will work just as the title attribute on HTML elements. (Since 2.50)
clickable : Boolean; // Toggles whether or not the marker is clickable. Markers that are not clickable or draggable are inert, consume less resources and do not respond to any events. The default value for this option is true, i.e. if the option is not specified, the marker will be clickable. (Since 2.50)
draggable : Boolean; // Toggles whether or not the marker will be draggable by users. Markers set up to be dragged require more resources to set up than markers that are clickable. Any marker that is draggable is also clickable, bouncy and auto-pan enabled by default. The default value for this option is false. (Since 2.61)
bouncy : Boolean; // Toggles whether or not the marker should bounce up and down after it finishes dragging. The default value for this option is false. (Since 2.61)
bounceGravity : Integer; // When finishing dragging, this number is used to define the acceleration rate of the marker during the bounce down to earth. The default value for this option is 1. (Since 2.61)
autoPan : Boolean; // Auto-pan the map as you drag the marker near the edge. If the marker is draggable the default value for this option is true. (Since 2.87)
// to implement:
// zIndexProcess : Function; // This function is used for changing the z-Index order of the markers when they are overlaid on the map and is also called when their infowindow is opened. The default order is that the more southerly markers are placed higher than more northerly markers. This function is passed in the GMarker object and returns a number indicating the new z-index. (Since 2.98)
end;
TGPoint=class
end;
TGLatLng=class(TInterfacedObject,IJsClassWrapper)
private
FLat,
FLng:Double;
FJsVarName: String;
function GetJsVarName: String;
procedure SetJsVarName(const Value: String);
published
constructor Create(aLat,aLng:Double);
property Lat:Double read FLat write FLat;
property Lng:Double read FLng write FLng;
function ToJavaScript:String;
function Equals(const AGLatLng:TGLatLng):Boolean;
function ToString:String;
function JsClassName:String;virtual;
property JsVarName:String read GetJsVarName write SetJsVarName;
end;
TGBounds=class(TInterfacedObject,IJsClassWrapper)
private
FJsVarName: String;
FMinX, FMinY, FMaxX, FMaxY:Double;
FMin,FMax,FMid:TGLatLng;
function GetMax: TGLatLng;
function GetMid: TGLatLng;
function GetMin: TGLatLng;
procedure SetJsVarName(const Value: String);
function GetJsVarName: String;
published
destructor Destroy;override;
property minX : Double read FMinX write FMinX;
property minY : Double read FMinY write FMinY;
property maxX : Double read FMaxX write FMaxX;
property maxY : Double read FMaxY write FMaxY;
function ToString:String;
function Equals(aGBounds:TGBounds):Boolean;
property Min:TGLatLng read GetMin;
property Mid:TGLatLng read GetMid;
property Max:TGLatLng read GetMax;
function JsClassName:String;virtual;
property JsVarName:String read GetJsVarName write SetJsVarName;
function ToJavaScript:String;
end;
TGLatLngBounds=class
private
procedure setNorthEast(const Value: TGLatLng);
procedure setSouthWest(const Value: TGLatLng);
published
constructor Create(sw,ne:TGLatLng);
destructor Destroy;override;
function contains(aLatLng:TGLatLng):Boolean; deprecated; // Returns true iff the geographical coordinates of the point lie within this rectangle. (Deprecated since 2.88)
function containsLatLng(aLatLng:TGLatLng):Boolean; // Returns true iff the geographical coordinates of the point lie within this rectangle. (Since 2.88)
function intersects(aGLatLngBounds:TGLatLngBounds):Boolean;
function containsBounds(aGLatLngBounds:TGLatLngBounds):Boolean;
procedure extend(aLatLng:TGLatLng); // Enlarges this rectangle such that it contains the given point. In longitude direction, it is enlarged in the smaller of the two possible ways. If both are equal, it is enlarged at the eastern boundary.
function toSpan() : TGLatLng; // Returns a GLatLng whose coordinates represent the size of this rectangle.
function isFullLat() : Boolean ; // Returns true if this rectangle extends from the south pole to the north pole.
function isFullLng() : Boolean ; // Returns true if this rectangle extends fully around the earth in the longitude direction.
function isEmpty() : Boolean ; // Returns true if this rectangle is empty.
function getCenter() : TGLatLng; // Returns the point at the center of the rectangle. (Since 2.52)
function getSouthWest() : TGLatLng; // Returns the point at the south-west corner of the rectangle.
function getNorthEast() : TGLatLng; // Returns the point at the north-east corner of the rectangle.
property SouthWest : TGLatLng read getSouthWest write setSouthWest;
property NorthEast : TGLatLng read getNorthEast write setNorthEast;
function ToString:String;
function Equals(aGLatLngBounds:TGLatLngBounds):Boolean;
end;
TColor = integer;
// abstract class.. subclassed by TGMarker and TGPolygon and TGPolyLine..
TGOverlay=class(TInterfacedObject,IJsClassWrapper,IHidable)
private
FID: Integer;
FGoogleMaps: TGoogleMaps;
FName: String;
FJsVarName:String;
procedure SetID(const Value: Integer);
procedure SetGoogleMaps(const Value: TGoogleMaps);
procedure SetName(const Value: String);
function GetJsVarName: String;
procedure SetJsVarName(const Value: String);
public
procedure hide;virtual;
function isHidden: Boolean;virtual;
procedure show;virtual;
function supportsHide: Boolean;virtual;
published
property ID:Integer read FID write SetID;
function ToJavaScript:String;virtual;abstract;
property JsVarName:String read GetJsVarName write SetJsVarName;
property GoogleMaps:TGoogleMaps read FGoogleMaps write SetGoogleMaps;
property Name:String read FName write SetName;
function JsClassName:string;virtual;
end;
TOverlayList=class(TObjectList)
private
AutoIncrementID:Integer;
function GetItems(Index: Integer): TGOverlay;
procedure SetItems(Index: Integer; const Value: TGOverlay);
public
property Items[Index:Integer]:TGOverlay read GetItems write SetItems; default;
published
constructor Create;
destructor Destroy;override;
function Add(aGOverlay:TGOverlay):Integer;
procedure Clear;override;
function ToString:String;
end;
TGInfoWindow=class(TGOverlay,IJsClassWrapper,IHidable)
procedure Maximize;
procedure Restore;
private
FHTML: String;
procedure SetHTML(const Value: String);
public
property HTML:String read FHTML write SetHTML;
function JsClassName:String;override;
constructor Create(const aCenter:TGLatLng);
destructor Destroy;override;
function ToJavaScript:String;override;
function supportsHide: Boolean;override;
end;
// used to show a location on a map
// can be dragged, can show a popup, can have custom colors and icon
TGMarker=class(TGOverlay,IJsClassWrapper,IHidable)
private
FCenter: TGLatLng;
FDraggingEnabled: Boolean;
procedure setLatLng(const Value: TGLatLng);
procedure SetDraggingEnabled(const Value: Boolean);
public
function supportsHide: Boolean;override;
published
function JsClassName:String;override;
constructor Create(const aCenter:TGLatLng);
destructor Destroy;override;
property Center:TGLatLng read FCenter write setLatLng;
property DraggingEnabled:Boolean read FDraggingEnabled write SetDraggingEnabled;
function ToJavaScript:String;override;
{ TODO 3 -oWouter : implement all marker methods and events }
procedure openInfoWindow(aContent:String); // Opens the map info window over the icon of the marker. The content of the info window is given as a DOM node. Only option GInfoWindowOptions.maxWidth is applicable.
procedure openInfoWindowHtml(aContent:String); // Opens the map info window over the icon of the marker. The content of the info window is given as a string that contains HTML text. Only option GInfoWindowOptions.maxWidth is applicable.
{ procedure openInfoWindowTabs(tabs, opts?) : none; // Opens the tabbed map info window over the icon of the marker. The content of the info window is given as an array of tabs that contain the tab content as DOM nodes. Only options GInfoWindowOptions.maxWidth and InfoWindowOptions.selectedTab are applicable.
procedure openInfoWindowTabsHtml(tabs, opts?) : none; // Opens the tabbed map info window over the icon of the marker. The content of the info window is given as an array of tabs that contain the tab content as Strings that contain HTML text. Only options InfoWindowOptions.maxWidth and InfoWindowOptions.selectedTab are applicable.
procedure bindInfoWindow(content, opts?) : none; // Binds the given DOM node to this marker. The content within this node will be automatically displayed in the info window when the marker is clicked. Pass content as null to unbind. (Since 2.85)
procedure bindInfoWindowHtml(content, opts?) : none; // Binds the given HTML to this marker. The HTML content will be automatically displayed in the info window when the marker is clicked. Pass content as null to unbind. (Since 2.85)
procedure bindInfoWindowTabs(tabs, opts?) : none; // Binds the given GInfoWindowTabs (provided as DOM nodes) to this marker. The content within these tabs' nodes will be automatically displayed in the info window when the marker is clicked. Pass tabs as null to unbind. (Since 2.85)
procedure bindInfoWindowTabsHtml(tabs, opts?) : none; // Binds the given GInfoWindowTabs (provided as strings of HTML) to this marker. The HTML content within these tabs will be automatically displayed in the info window when the marker is clicked. Pass tabs as null to unbind. (Since 2.85)
procedure closeInfoWindow() : none; // Closes the info window only if it belongs to this marker. (Since 2.85)
procedure showMapBlowup(opts?) : none; // Opens the map info window over the icon of the marker. The content of the info window is a closeup map around the marker position. Only options InfoWindowOptions.zoomLevel and InfoWindowOptions.mapType are applicable.
procedure getIcon() : GIcon; // Returns the icon of this marker, as set by the constructor.
procedure getTitle() : String; // Returns the title of this marker, as set by the constructor via the GMarkerOptions.title property. Returns undefined if no title is passed in. (Since 2.85)
procedure getPoint() : GLatLng; // Returns the geographical coordinates at which this marker is anchored, as set by the constructor or by setPoint(). (Deprecated since 2.88)
procedure getLatLng() : GLatLng; // Returns the geographical coordinates at which this marker is anchored, as set by the constructor or by setLatLng(). (Since 2.88)
procedure setPoint(latlng) : none; // Sets the geographical coordinates of the point at which this marker is anchored. (Deprecated since 2.88)
procedure setLatLng(latlng) : none; // Sets the geographical coordinates of the point at which this marker is anchored. (Since 2.88)
procedure enableDragging() : none; // Enables the marker to be dragged and dropped around the map. To function, the marker must have been initialized with GMarkerOptions.draggable = true.
procedure disableDragging() : none; // Disables the marker from being dragged and dropped around the map.
procedure draggable() : Boolean; // Returns true if the marker has been initialized via the constructor using GMarkerOptions.draggable = true. Otherwise, returns false.
procedure draggingEnabled() : Boolean; // Returns true if the marker is currently enabled for the user to drag on the map.
procedure setImage(url) : none; // Requests the image specified by the url to be set as the foreground image for this marker. Note that neither the print image nor the shadow image are adjusted. Therefore this method is primarily intended to implement highlighting or dimming effects, rather than drastic changes in marker's appearances. (Since 2.75)
}
end;
TGGeoXml=class(TGOverlay,IJsClassWrapper,IHidable)
private
FUrlOfXml: String;
procedure SetUrlOfXml(const Value: String);
published
// function getTileLayerOverlay: GTileLayerOverlay; // GGeoXml objects may create a tile overlay for optimization purposes in certain cases. This method returns this tile layer overlay (if available). Note that the tile overlay may be null if not needed, or if the GGeoXml file has not yet finished loading. (Since 2.84)
// function getDefaultCenter : GLatLng; // Returns the center of the default viewport as a lat/lng. This function should only be called after the file has been loaded. (Since 2.84)
// function getDefaultSpan : GLatLng; // Returns the span of the default viewport as a lat/lng. This function should only be called after the file has been loaded. (Since 2.84)
// function getDefaultBounds : GLatLngBounds; // Returns the bounding box of the default viewport. This function should only be called after the file has been loaded. (Since 2.84)
procedure gotoDefaultViewport(Map:TGoogleMaps); // Sets the map's viewport to the default viewport of the XML file. (Since 2.84)
// function hasLoaded : Boolean; // Checks to see if the XML file has finished loading, in which case it returns true. If the XML file has not finished loading, this method returns false. (Since 2.84)
// function loadedCorrectly : Boolean; // Checks to see if the XML file has loaded correctly, in which case it returns true. If the XML file has not loaded correctly, this method returns false. If the XML file has not finished loading, this method's return value is undefined. (Since 2.84)
function supportsHide : Boolean; override; // Always returns true. (Since 2.87)
function JsClassName:String;override;
constructor Create(const aUrlOfXml:String);
destructor Destroy;override;
property UrlOfXml:String read FUrlOfXml write SetUrlOfXml;
function ToJavaScript:String;override;
end;
// polygon class
TGPolygon=class(TGOverlay,IJsClassWrapper,IHidable)
private
FCoordinates:Array of TGLatLng;
FOpacity: double;
FWeightPx: integer;
FColor: TColor;
FSimplified: TGPolygon;
FIsDirty: Boolean;
procedure SetColor(const Value: TColor);
procedure SetOpacity(const Value: double);
procedure SetWeightPx(const Value: integer);
function GetCount: Integer;
procedure SetSimplified(const Value: TGPolygon);
function GetSimplified: TGPolygon;
public
constructor Create(const aCoordinates: array of TGLatLng);overload;
constructor Create(const aPoints:Array of TPointFloat2D);overload;
function supportsHide: Boolean;override;
published
function JsClassName:String;override;
procedure Clear;
function ToJavaScript:String;override;
function AddPoint(const aGLatLng:TGLatLng):integer;
property Color:TColor read FColor write SetColor;
property WeightPx:integer read FWeightPx write SetWeightPx;
property Opacity:double read FOpacity write SetOpacity;// number between 0 and 1
property Count:Integer read GetCount;
destructor Destroy;override;
property IsDirty:Boolean read FIsDirty write FIsDirty;
property Simplified:TGPolygon read GetSimplified write SetSimplified;
function getSimplifiedVersion(Tolerance:Double=DEFAULT_SIMPLIFY_TOLERANCE):TGPolygon;
class function PolyTypeStr: String;virtual;
end;
TGPolyLine=class(TGPolygon,IJsClassWrapper,IHidable)
published
class function PolyTypeStr:String;override;
function JsClassName:String;override;
end;
TGCopyright=class(TGOverlay,IJsClassWrapper,IHidable)
private
FminZoom: Integer;
Fid: Integer;
Fbounds: TGLatLngBounds;
Ftext: String;
procedure Setbounds(const Value: TGLatLngBounds);
procedure Setid(const Value: Integer);
procedure SetminZoom(const Value: Integer);
procedure Settext(const Value: String);
published
property id : Integer read Fid write Setid; // A unique identifier for this copyright information.
property minZoom : Integer read FminZoom write SetminZoom; // The lowest zoom level at which this information applies.
property bounds : TGLatLngBounds read Fbounds write Setbounds; // The region to which this information applies.
property text : String read Ftext write Settext; // The text of the copyright message.
constructor Create (aId : Integer; aBounds:TGLatLngBounds;aMinZoom:Integer;aText:String);
end;
TGoogleMaps=class(TPanel)
private
FWebBrowser:TWebBrowser;
FhasEnd: Boolean;
FhasStart: Boolean;
FLogLines: TStrings;
FOverlays: TOverlayList;
FMapType: TGoogleMapType;
FLatLngCenter: TGLatLng;
FEnableDoubleClickZoom: Boolean;
FEnableContinuousZoom: Boolean;
FStatusPanel: TPanel;
FJsVarName: String;
procedure LoadHTML(URL:String);
procedure SetLogLines(const Value: TStrings);
procedure SetOverlays(const Value: TOverlayList);
procedure Init;
procedure SaveGoogleMapsHtml(const aFileName:String);
procedure SetLatLngCenter(const Value: TGLatLng);
procedure SetEnableContinuousZoom(const Value: Boolean);
procedure SetEnableDoubleClickZoom(const Value: Boolean);
function GetLatLngCenter: TGLatLng;
property WebBrowser : TWebBrowser read FWebBrowser write FWebBrowser;
procedure SetMapType(AMapType:TGoogleMapType);
procedure SaveHTML(const FileName:String);
function GetHTML: String;
property hasStart : Boolean read FhasStart write FhasStart;
property hasEnd : Boolean read FhasEnd write FhasEnd;
procedure SetStatusPanel(const Value: TPanel);
procedure SetJsVarName(const Value: String);
property DragKind;
property DragMode;
property DockSite;
property Ctl3D;
property BiDiMode;
property AutoSize;
property HelpContext;
property HelpKeyword;
property HelpType;
property Owner;
property ParentBackground;
property ParentBiDiMode;
property ParentCtl3D;
property Showing;
property UseDockManager;
property VerticalAlignment;
property WheelAccumulator;
public
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure SetCenter(Lat,Lng,Alt:Double;doPan:Boolean=false);overload;
procedure SetCenter(Lat,Lng:Double;doPan:Boolean=false);overload;
procedure SetCenter(LatLng:TGLatLng;doPan:Boolean=false);overload;
procedure HandleOnResize(Sender:TObject);
function GetJsValue(aJavaScript:String):OleVariant;
property HTML: String read GetHTML;
procedure CheckResize;
published
property StatusPanel : TPanel read FStatusPanel write SetStatusPanel;
property LogLines : TStrings read FLogLines write SetLogLines;
property Overlays : TOverlayList read FOverlays write SetOverlays;
property LatLngCenter : TGLatLng read GetLatLngCenter write SetLatLngCenter;
property EnableContinuousZoom:Boolean read FEnableContinuousZoom write SetEnableContinuousZoom default true;
property EnableDoubleClickZoom:Boolean read FEnableDoubleClickZoom write SetEnableDoubleClickZoom default true;
property MapType:TGoogleMapType read FMapType write SetMapType;
property JsVarName:String read FJsVarName write SetJsVarName;
procedure AddControl(ControlType:TGoogleMapControl);
procedure AddStartMarker;
procedure AddEndMarker;
procedure AddMarker(Lat,Lon:Double);
procedure AddPolygon(GPolygon:TGPolygon);
procedure AddOverlay(aOverlay:TGOverlay);
procedure RemoveOverlay(aOverlay:TGOverlay);
procedure RemoveOverlayByIndex(Index:Integer);
procedure ClearOverlays;
procedure SwapBeginEndMarkers;
procedure GetDirections;
procedure ShowAddress(const Street,City,State,Country:String);
procedure openInfoWindow(aLatlng : TGLatLng; aHTML:String);
procedure closeInfoWindow;
procedure ExecJavaScript(const aScript:String);
procedure WebBrowserDocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant);
procedure OnMouseOver;
property Align;
property OnClick;
property OnCanResize;
property OnResize;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnDblClick;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnConstrainedResize;
If you're looking to get directions and you're prepared to write some javascript, you can use GDirections, which is part of the GoogleMaps API.
I have an example Delphi program at Google Maps in a TWebBrowser from Delphi: Directions which you might find helpful. (Zip of project).
A quick Google search on "Google maps delphi" turned up 10+ pages of hits. Among the top 3 was Using Google Maps from a VCL Sample Application
Beware for the legal concequences. We tried something like that but removed it because we found no possibility to solve it legally. It looks like Googlemaps is not designed for desktop. Which isn't extremely surprising.
You can get nice results with kml and google earth by the way.
You are correct, there is no other [legal] way to embed a google map into a desktop app: you must use a WeBrowser type of control. It varies by language of course (as you noticed with the Mozilla C++ component), but your options are very limited otherwise.
Work on Embedding Mozilla within Delphi appears to have stalled some years ago but there is a still an article from Irongut on embedding it. It was never a fully satisfactory solution as I understand it because it required a hefty additional distribution of Mozilla files (even if the user already had Mozilla/FF installed).
As Gamecat suggested, Google Earth can achieve some nice results. I found a simple sample project of Embedding Google Earth within a Delphi Application on a the "Google Earth Airlines site". This might be enough to show you whether this solution might fit your needs.
The only service I've been able to locate that offered decent support for a desktop app was MapQuest. I wrote an introductory article back in August on how to use MapQuest with Delphi here to extract Lat/Lng values. It's basically all XML message formatting to interact with their server.
I saw Marco Cantù's demo of this at Delphi Developer Days earlier this month. It was very awesome. Pretty sure he used Indy for everything.
Related
I need to draw angled text on TDirect2DCanvas, but no success.
procedure TForm1.FormPaint(Sender: TObject);
var
LCanvas: TDirect2DCanvas;
const
myText = 'Kikimor';
begin
LCanvas := TDirect2DCanvas.Create(Canvas, ClientRect);
LCanvas.BeginDraw;
try
LCanvas.Font.Orientation := 90;
LCanvas.TextOut(100,100,myText);
finally
LCanvas.EndDraw;
LCanvas.Free;
end;
end;
No matter what angle I give for orientation, it always draws a straight text.
Is orientation not working or I need to do something else?
Setting TDirect2DCanvas.Font.Orientation does not have any effect (most likely not implemented, sorry, no time to debug). Direct2D wrapper supplied in Delphi is very basic.
To achieve your goal, apply transformation by hand:
procedure TForm1.FormPaint(Sender: TObject);
var
LCanvas: TDirect2DCanvas;
currentTransform: TD2D1Matrix3x2F;
ptf: TD2DPoint2f;
const
myText = 'Kikimor';
begin
LCanvas := TDirect2DCanvas.Create(self.Canvas, ClientRect);
LCanvas.BeginDraw;
try
// backup the current transformation
LCanvas.RenderTarget.GetTransform(currentTransform);
ptf.x:= 100.0; ptf.y:= 100.0; //rotation center point
// apply transformation to rotate text at 90 degrees:
LCanvas.RenderTarget.SetTransform(TD2D1Matrix3x2F.Rotation(90, ptf));
// draw the text (rotated)
LCanvas.TextOut(100, 100, myText);
// restore the original transform
LCanvas.RenderTarget.SetTransform(currentTransform);
finally
LCanvas.EndDraw;
LCanvas.Free;
end;
end;
For more extensive information/effects you can look at:
Drawing text using the IDWriteTextLayout.Draw()
The whole Direct2D category at the same site is also interesting (use Google Translate).
For those using C++ Builder I got this to work:
#include <Vcl.Direct2D.hpp>
// needed for the D2D1::Matrix3x2F::Rotation transform
#ifdef _WIN64
#pragma comment(lib,"D2D1.a")
#else
#pragma comment(lib,"D2D1.lib")
#endif
TD2DPoint2f point; // rotation centre
point.x = 100.0;
point.y = 100.0;
canvas_2d->RenderTarget->SetTransform(D2D1::Matrix3x2F::Rotation(90, point));
canvas_2d->TextOut(100, 100, text);
// restore 0 rotation afterwards
canvas_2d->RenderTarget->SetTransform(D2D1::Matrix3x2F::Rotation(0, point));
Note that trying to use GetTransform like in the Delphi version causes an exception, so I cleared the transform by passing it a new one with zero rotation, there may be a better way to do this.
The pragma is needed due to a link error, see this answer for details.
I want to convert the workspace coordinates returned by GetWindowPlacement in rcNormalPosition.Left and rcNormalPosition.Top to screen coordinates that I can assign later to MainForm.Left and MainForm.Top. How can I do that ?
You can use the monitor property of your form to determine if the workspace of the monitor that the form is on has got any offset with the monitor's placement. E.g.
ScreenLeft := wplc.rcNormalPosition.Left +
Monitor.WorkareaRect.Left - Monitor.Left;
ScreenTop := wplc.rcNormalPosition.Top +
Monitor.WorkareaRect.Top - Monitor.Top;
The simplest and cleanest way is to use the API function that partners with GetWindowPlacement, namely SetWindowPlacement. That way you don't need to convert between workspace and screen coordinates because you let the system do the work for you.
var
WindowPlacement: TWindowPlacement;
....
WindowPlacement.length := SizeOf(WindowPlacement);
Win32Check(GetWindowPlacement(Handle, WindowPlacement));
....
Win32Check(SetWindowPlacement(Handle, WindowPlacement));
In the above code, Handle is assumed to be the window handle of the form.
If you have persisted the left and top then you'd restore them like this:
var
WindowPlacement: TWindowPlacement;
....
WindowPlacement.length := SizeOf(WindowPlacement);
Win32Check(GetWindowPlacement(Handle, WindowPlacement));
WindowPlacement.rcNormalPosition.Left := NewLeft;
WindowPlacement.rcNormalPosition.Top := NewTop;
Win32Check(SetWindowPlacement(Handle, WindowPlacement));
How can I make something like this in Delphi:
I know I can make it from 3 tables so it would be easier, but how can I make Table cells split & merge and how to get the text to turn 90deg.?
Is there some good content libraries that have split & merge built in?
Check out woll2woll or infopower. They will do the grid for sure. The font can be achieved by overriding the OnDrawDataCell, OnDrawGroupHeaderCell and OnDrawTitleCell events and writing the text with rotated font.
{****************************************************************
* Create angled font. Procedure writen by Keith Wood *
****************************************************************}
procedure CreateAngledFont (AFont : TFont; const AAngle : Integer);
var
FntLogRec: TLogFont { Storage area for font information } ;
begin
{ Get the current font information. We only want to modify the angle }
fillchar (FntLogRec, sizeof(FntLogRec), #0);
GetObject (AFont.Handle, SizeOf(FntLogRec), Addr(FntLogRec));
{ Modify the angle. "The angle, in tenths of a degrees, between the base
line of a character and the x-axis." (Windows API Help file.) }
FntLogRec.lfEscapement := (AAngle * 10);
FntLogRec.lfOrientation := (AAngle * 10);
FntLogRec.lfOutPrecision := OUT_TT_PRECIS; { Request TrueType precision }
{ Delphi will handle the deallocation of the old font handle }
AFont.Handle := CreateFontIndirect (FntLogRec);
end;
I am attempting to translate this code from Delphi to C++ Builder:
procedure HandleStyleSheets(const Document: IDispatch);
var
Doc: IHTMLDocument2; // document object
StyleSheets: IHTMLStyleSheetsCollection; // document's style sheets
SheetIdx: Integer; // loops thru style sheets
OVSheetIdx: OleVariant; // index of a style sheet
StyleSheet: IHTMLStyleSheet; // reference to a style sheet
OVStyleSheet: OleVariant; // variant ref to style sheet
RuleIdx: Integer; // loops thru style sheet rules
Style: IHTMLRuleStyle; // ref to rule's style
begin
// Get IHTMLDocument2 interface of document
if not Supports(Document, IHTMLDocument2, Doc) then
Exit;
// Loop through all style sheets
StyleSheets := Doc.styleSheets;
for SheetIdx := 0 to Pred(StyleSheets.length) do
begin
OVSheetIdx := SheetIdx; // sheet index as variant required for next call
// Get reference to style sheet (comes as variant which we convert to
// interface reference)
OVStyleSheet := StyleSheets.item(OVSheetIdx);
if VarSupports(OVStyleSheet, IHTMLStyleSheet, StyleSheet) then
begin
// Loop through all rules within style a sheet
for RuleIdx := 0 to Pred(StyleSheet.rules.length) do
begin
// Get style from a rule and reset required attributes.
// Note: style is IHTMLRuleStyle, not IHTMLStyle, although many
// attributes are shared between these interfaces
Style := StyleSheet.rules.item(RuleIdx).style;
Style.backgroundImage := ''; // removes any background image
Style.backgroundColor := ''; // resets background colour to default
end;
end;
end;
end;
Everything went fine until this line:
if (VarSupports(OVStyleSheet, IID_IHTMLStyleSheet, StyleSheet))
It reports: E2285 Could not find a match for 'VarSupports(OleVariant,_GUID,_di_IHTMLStyleSheet)'
Everything else translated just fine. Can anyone help me with above line?
My translation so far:
DelphiInterface<IHTMLDocument2> Doc; // document object
DelphiInterface<IHTMLStyleSheetsCollection> StyleSheets; // document's style sheets
int SheetIdx; // loops thru style sheets
OleVariant OVSheetIdx; // index of a style sheet
DelphiInterface<IHTMLStyleSheet> StyleSheet; // reference to a style sheet
OleVariant OVStyleSheet; // variant ref to style sheet
int RuleIdx; // loops thru style sheet rules
DelphiInterface<IHTMLRuleStyle> Style; // ref to rule's style
DelphiInterface<IHTMLStyleSheetRule> StyleSheetRule;
// Get IHTMLDocument2 interface of document
if (!Supports(EmbeddedWB1->Document, IID_IHTMLDocument2, Doc)) throw Exception("Not supported");
// Loop through all style sheets
StyleSheets = Doc->styleSheets;
for (SheetIdx = 0; SheetIdx < StyleSheets->length; SheetIdx++)
{
OVSheetIdx = SheetIdx; // sheet index as variant required for next call
// Get reference to style sheet (comes as variant which we convert to interface reference)
StyleSheets->item(OVSheetIdx, OVStyleSheet);
if (VarSupports(OVStyleSheet, IID_IHTMLStyleSheet, StyleSheet))
{
// Loop through all rules within style a sheet
for (RuleIdx = 0; RuleIdx < StyleSheet->rules->length; RuleIdx)
{
// Get style from a rule and reset required attributes.
// Note: style is IHTMLRuleStyle, not IHTMLStyle, although many
// attributes are shared between these interfaces
StyleSheet->rules->item(RuleIdx, StyleSheetRule);
Style = StyleSheetRule->style;
Style->backgroundImage = L""; // removes any background image
Style->backgroundColor = L""; // resets background colour to default
}
}
}
}
The reason for the compile error is that VarSupports is defined as taking a Variant, and you are passing an OleVariant.
It looks to me as if the code is trying to assign the OVStyleSheet to the IHTMLStyleSheet interface StyleSheet. In C++ Builder, you should be able to just assign it, as in
_di_IInterface inter = _di_IInterface(OVStyleSheet);
StyleSheet = inter;
If that succeeds and StyleSheet is not NULL, you should be able to use StyleSheet. Note that invalid Variant assignments can throw an exception, so you might want to handle that (and assume that the exception also means that the OVStyleSheet does not support the IHTMLStyleSheet interface)
Also, C++ Builder has an Interface.Supports function that appears to do what VarSupports does, except that VarSupports takes a variant, so Interface.Supports also requires you to obtain the interface from the OleVariant yourself. Probably something like:
di_IInterface inter = _di_IInterface(OVStyleSheet);
if (inter->Supports(StyleSheet))
{
ShowMessage("StyleSheet has been assigned");
}
This compiles, but I have not tested it.
How do you programmatically change the resolution of a specific monitor? For instance can the secondary monitor resolution be programmatically changed?
The following function might be your starting point. It tries to change the resolution of a display device with index specified by the Index parameter (if exists such) to a width and height (in pixels) given by the Width, Height parameters. The function returns True, if the display device with given index is found and the resolution of it has been successfully changed, False otherwise.
You haven't specified whether you want to change the resolution permanently (if you want to store the setting changes), or change it only temporarily. The following example does it temporarily, but you can quite simply change this behavior if you use in the second ChangeDisplaySettingsEx function call the CDS_UPDATEREGISTRY value for the dwflags parameter:
function ChangeMonitorResolution(Index, Width, Height: DWORD): Boolean;
var
DeviceMode: TDeviceMode;
DisplayDevice: TDisplayDevice;
begin
Result := False;
ZeroMemory(#DisplayDevice, SizeOf(DisplayDevice));
DisplayDevice.cb := SizeOf(TDisplayDevice);
// get the name of a device by the given index
if EnumDisplayDevices(nil, Index, DisplayDevice, 0) then
begin
ZeroMemory(#DeviceMode, SizeOf(DeviceMode));
DeviceMode.dmSize := SizeOf(TDeviceMode);
DeviceMode.dmPelsWidth := Width;
DeviceMode.dmPelsHeight := Height;
DeviceMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
// check if it's possible to set a given resolution; if so, then...
if (ChangeDisplaySettingsEx(PChar(#DisplayDevice.DeviceName[0]),
DeviceMode, 0, CDS_TEST, nil) = DISP_CHANGE_SUCCESSFUL)
then
// change the resolution temporarily (if you use CDS_UPDATEREGISTRY
// value for the penultimate parameter, the graphics mode will also
// be saved to the registry under the user's profile; for more info
// see the ChangeDisplaySettingsEx reference, dwflags parameter)
Result := ChangeDisplaySettingsEx(PChar(#DisplayDevice.DeviceName[0]),
DeviceMode, 0, 0, nil) = DISP_CHANGE_SUCCESSFUL;
end;
end;
An example how to change resolution of a secondary display device (device with index 1) to 800x600:
procedure TForm1.Button1Click(Sender: TObject);
begin
if ChangeMonitorResolution(1, 800, 600) then
ShowMessage('Resolution of display device with index 1 has been changed!')
else
ShowMessage('Display device with index 1 doesn''t exist, doesn''t support ' +
'resolution 800x600 or changing failed due to a reason, which you might ' +
'know if the author of this function wouldn''t be so lazy!');
end;