Unit1
-----
procedure TForm1.Button1Click(Sender: TObject);
var
Bounds: TLatLngBounds;
CircleOptions: TCircleOptions;
Lat, Lng: Double;
begin
if not assigned(Script)
or not assigned(Script.Maps[0])
then Exit;
with Script
do
begin
Bounds:=Maps[0].Bounds;
//angezeigter Kartenbereich ermitteln
Lat:=Bounds.GetSouthWest.Lat+Random*
//zufällige Position innerhalb des
(Bounds.GetNorthEast.Lat-Bounds.GetSouthWest.Lat);
//angezeigter Kartenbereichs berechnen
Lng:=Bounds.GetSouthWest.Lng+Random*
//-"-
(Bounds.GetNorthEast.Lng-Bounds.GetSouthWest.Lng);
CircleOptions:=TCircleOptions.Create;
//Zirkeloptions-Objekt erstellen
CircleOptions.Center:=Google.Maps.LatLng(Lat,Lng);
//Zirkelmittelpunkt
CircleOptions.Clickable:=false;
//nicht anklickbar
CircleOptions.FillColor:=clNone;
//Füllfarbe
CircleOptions.FillOpacity:=0;
//Deckkraft der Füllung (0 -> vollkommen transparent)
CircleOptions.Map:=Maps[0];
//Kartenobjekt zuweisen
CircleOptions.Radius:=round((20+Random(80))/100*
//Zirkelradius in Metern
1/8*
//1/8 der Kartendiagonale
Distance_km(Bounds.GetNorthEast,Bounds.GetSouthWest)*
1000);
//km -> m
CircleOptions.StrokeColor:=RGBToColor(Random(255),
//zufällige Linienfarbe
Random(255),Random(255));
CircleOptions.StrokeOpacity:=0.5;
//Deckraft der Linie
CircleOptions.StrokeWeight:=5;
//Linienbreite in Pixeln
CircleOptions.ZIndex:=0;
//vertikale Position
Script.Google.Maps.Circle(CircleOptions);
//Zirkel-Objekt erstellen
end;
end;
gmAPI
-----
function TMaps.Circle(Opts: TCircleOptions): TCircle;
begin
if not assigned(Opts)
then raise Exception.Create(NoOpts);
Result:=CreateCircleWrapper(Script,BrowserTools.Create(Disp,MapsMethod_Circle,Opts.Disp));
TScript(Script).Circles.Add(Result);
end;
gmOverlays
----------
function CreateCircleWrapper(Script: TCustomScript; Dispatch: IDispatch): TCircle;
begin
Result:=TCircle.Create(Script,Dispatch);
end;
TCircle =
class(TMVCEventObject)
gmMVC
-----
TMVCEventObject =
class(TMVCObject)
//Zwischenobjekt, gibt es nicht im GoogleMaps API
TMVCObject =
class(TJScriptObject)
JScriptObjects
--------------
TJScriptObject =
class(TScriptObject)
TScriptObject =
class(TDispObject)
private
FScript: TCustomScript;
protected
constructor Create(Script: TCustomScript; Dispatch: IDispatch);
reintroduce;
virtual;
procedure FreeNotify(Sender: TObject);
override;
function GetPropAsObject(
const Name:
String; PropClass: TDispObjectClass;
var PropObject): TDispObject;
override;
property Script: TCustomScript
read FScript;
public
end;
TDispObject
-----------
TDispObject =
class(TNotifyObject)
private
FDisp: IDispatch;
function GetDispEx: IDispatchEx;
protected
constructor Create(Dispatch: IDispatch);
virtual;
procedure AddProp(
const Name:
String; Value: TDispObject);
overload;
procedure SetDisp(Value: IDispatch);
virtual;
procedure SetProp(
const Name:
String;
const Value: OleVariant; CreateIfNotExists: Boolean = false);
overload;
procedure SetProp(
const Name:
String; DispObject: TDispObject; CreateIfNotExists: Boolean = false);
overload;
procedure SetProp(
DispID: Integer;
const Value: OleVariant);
overload;
function Exec(
const Name:
String): OleVariant;
overload;
function Exec(
const Name:
String; DispObject: TDispObject): OleVariant;
overload;
//function Exec(const Name: String; const Param: OleVariant): OleVariant; overload;
function Exec(
const Name:
String;
const Params:
array of OleVariant): OleVariant;
overload;
function AddProp(
const Name:
String): Boolean;
overload;
function DelProp(
const Name:
String): Boolean;
function GetProp(
const Name:
String;
const Param:
String = '
'): OleVariant;
function GetPropAsVariant(
const Name:
String): OleVariant;
function GetPropAsDispatch(
const Name:
String): IDispatch;
function GetPropAsObject(
const Name:
String; PropClass: TDispObjectClass;
var PropObject): TDispObject;
virtual;
function GetPropAsBoolean(
const Name:
String;
Default: Boolean = false): Boolean;
function GetPropAsInteger(
const Name:
String;
Default: Integer = 0): Integer;
function GetPropAsString(
const Name:
String;
const Default:
String = '
'):
String;
function GetPropAsDouble(
const Name:
String;
Default: Double = 0): Double;
public
destructor Destroy;
override;
class function IsObjectFromDisp(Disp: IDispatch): Boolean;
virtual;
function AsVariant: Variant;
function PropertyExists(
Name:
String): Boolean;
property Disp: IDispatch
read FDisp
write SetDisp;
property DispEx: IDispatchEx
read GetDispEx;
end;
INotifyInterface =
interface(
{$IFDEF DELPHI6_UP}IInterface
{$ELSE}IUnknown
{$ENDIF})
['
{6971F829-8011-4E6C-B6BD-FAA86048E059}']
procedure FreeNotification(Sender: INotifyInterface);
procedure RegisterNotification(AInterface: INotifyInterface);
procedure UnregisterNotification(AInterface: INotifyInterface);
function GetObject: TObject;
end;
TNotifyObject =
class(TObject, INotifyInterface)
private
FNotifications: TInterfaceList;
protected
procedure FreeNotify(Sender: TObject);
virtual;
procedure DelObjectRef(AInterface: INotifyInterface;
var AObject);
overload;
procedure DelObjectRef(Instance: TObject;
var AObject);
overload;
function GetObject: TObject;
//Interface-Methoden:
function QueryInterface(
const IID: TGUID;
out Obj): HResult;
stdcall;
function _AddRef: Integer;
stdcall;
function _Release: Integer;
stdcall;
procedure FreeNotification(Sender: INotifyInterface);
procedure RegisterNotification(AInterface: INotifyInterface);
procedure UnregisterNotification(AInterface: INotifyInterface);
public
procedure BeforeDestruction;
override;
end;
Zitat
Baum-Darstellung
