www.pudn.com > MapLegend.rar > Unit1.pas
//This is a main form for testing Legend component.
//How to use the legend.
//1.Move the legend by press at the border of the legend and drag to needed position.
//2.Resize the legend at the right bottom corner of the legend.
//3.Right click to call popupmenu to set some properties likes align, font, refresh, exporttoBmp
//4.If you want to drag and drop the layer. Don't forget to press Ctrl on keyboard.
//5.Double clikc at layer, You can modify some renderer properties by calling unit
//Moview2_LayerSymbol that is taken from Moview2 at http://arcscripts.esri.com/details.asp?dbid=14019.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, OleCtrls, MapObjects2_TLB, ComCtrls, StrUtils,
StdCtrls, Menus, MapLegend_Legend, MapLegend_PanelEx;
type
TForm1 = class(TForm)
Map1: TMap;
MapLegend1: TMapLegend;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Map1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormActivate(Sender: TObject);
//Double click to call frmLayerSymbol at Moview2_LayerSymbol unit.
procedure MapLegend1LayerDblClick(Sender: TObject; index: Integer);
procedure Map1AfterLayerDraw(ASender: TObject; index: Smallint;
canceled: WordBool; hDC: Cardinal);
procedure MapLegend1RenderClick(Sender: TObject; LayerIndex,
BreakIndex: Integer; val1, val2: Variant);
procedure Memo1Click(Sender: TObject);
private
{ Private declarations }
FActiveLayer : IDispatch;
FLayerIndex : integer;
//TEST PROCEDURE
procedure CoutiesClassBreaksRenderer;
procedure HighwayValueMapRender;
procedure StatesBoundaryValueMapRender;
procedure CountiesDotDensityRenderer;
procedure StatesDotDensityRenderer;
function IsCOMType(TypeOfObject:TGUID;rObject:IDispatch):BOOL;
procedure AddFiles;
procedure AddShapeFile(basePath:string; shpfile:string);
procedure AddImage(imageFile:string);
public
{ Public declarations }
//Design to be public so can call from MoView2_LayerSymbol(frmLayerSymbol).
property ActiveLayer : IDispatch read FActiveLayer write FActiveLayer;
end;
var
Form1: TForm1;
implementation
uses MoView2_LayerSymbol;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
MapLegend1.SetMapSource (Map1);
end;
procedure TForm1.Map1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
r :IMoRectangle;
begin
if button = mbleft then
// zoom in
begin
r :=map1.TrackRectangle;
if (varisempty(r) =false) then
map1.extent :=r;
end
else if (button = mbRight) then
begin
// zoom out
r :=map1.extent;
r.ScaleRectangle(variant(1.5));
map1.extent :=r;
end
//Pan
else if (button = mbMiddle) then
begin
map1.Pan;
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
var
i : integer;
lyr : IMoMapLayer;
begin
AddFiles;
//StatesDotDensityRenderer;
StatesBoundaryValueMapRender;
HighwayValueMapRender;
CoutiesClassBreaksRenderer;
//CountiesDotDensityRenderer;
MapLegend1.LoadLegend(true);
//This is a test for show layer at the range of scale.
//Set range of scale to show for layer index = 1 (ushigh).
//Must call after MapLegend1.LoadLegend.
MapLegend1.MinimumScaleToShow[1] := 0.60; //Highest number is 1.00
MapLegend1.MaximumScaleToShow[1] := 0.005; //Lowest number is 0.00
end;
procedure TForm1.AddFiles;
var
FilePath : string;
begin
//Must be sure, you have the folder 'data' under MaplegendDemo path.
FilePath := ExtractFilePath(Application.ExeName) + 'data\';
AddShapeFile(FilePath, 'counties.shp');
AddShapeFile(FilePath, 'states.shp');
AddImage(FilePath + 'map485941215.tif');
AddShapeFile(FilePath, 'ushigh.shp');
AddShapeFile(FilePath, 'capitals.shp');
end;
procedure TForm1.AddShapeFile(basePath:string; shpfile:string);
var
dCon:IMoDataConnection;
gSet:IMoGeoDataset;
strShapeFileType:string;
newLayer:IMoMapLayer;
begin
// This Method validates and adds a shape file to
// the Layers collection.
dCon := CoDataConnection.Create;
dCon.Database := WideString(basePath);
dCon.Connect;
if (bool(dCon.Connected)) then
begin
if (Pos('.',shpfile)>0) then
shpfile := MidStr(shpfile,1,Pos('.',shpfile)-1);
gSet := dCon.FindGeoDataset(WideString(shpfile));
if (gSet=NIL) then
begin
ShowMessage('Error opening shapefile '+shpfile);
exit;
end
else if (bool(gSet.HasZ)) then
strShapeFileType := '[SHAPEFILE]'
else
strShapeFileType := '[SHAPEFILE]';
newLayer := CoMapLayer.Create;
newLayer.GeoDataset := gSet;
newLayer.Name := WideString(shpfile);
// Attach path location to the Layer's Tag, also add '['SHAPEFILE] or
// '[SHAPEFILZ]' to the Tag so that any subsequent addressmatching
// or Elevation rendering will be able to tell that this is a
// shapefile, and if so, if the shapefile supports Z shapes.
newLayer.Tag := WideString(strShapeFileType+basePath+'|'+newLayer.Name);
Map1.Layers.Add(newLayer);
end
else
ShowMessage('Connection error');
end;
procedure TForm1.AddImage(imageFile:string);
var
iLayer:IMoImageLayer;
begin
// This procedure validates and adds an image file to the Layers collection
iLayer := CoImageLayer.Create;
iLayer.File_ := WideString(imageFile);
// If the file is a valid image file, add it and move it to the bottom
// (last index) of the layers collection
if Not(Map1.Layers.Add(iLayer)) then
// Map1.Layers.MoveToBottom(0)
//else
ShowMessage('This file, '+ imageFile +', is not a valid image file');
end;//addImage(String fullFile)
//---------------------------------------------------------------------------
procedure TForm1.StatesBoundaryValueMapRender;
var
strings : IMoStrings;
ly : IMoMapLayer;
recs : IMoRecordset;
s : String;
i : integer;
//lyr : IMoMapLayer;
lyrs : IMoLayers;
flds : IMoFields;
fld : IMoField;
ren : IMoValueMapRenderer;
begin
lyrs := IMoLayers(Map1.layers);
strings := coStrings.Create;
ly := coMapLayer.Create;
ly := IMoMapLayer(lyrs.item('states'));
recs := IMoRecordset(ly.records);
while not recs.eof do
begin
flds := IMoFields(recs.fields);
fld := IMoField(flds.item('STATE_NAME'));
s := fld.value;
strings.add(s);
recs.movenext;
end;
ren := coValueMapRenderer.Create;
ren.Field :='STATE_NAME';
// add the unique values to the renderer
ren.ValueCount :=strings.count;
for i :=0 to Strings.Count-1 do
ren.value[i]:= strings.Item (i);
ly.renderer := ren;
//Map1.Refresh;
ly:=nil;
strings:=nil;
ren:=nil;
end;
procedure TForm1.MapLegend1LayerDblClick(Sender: TObject; Index: Integer);
begin
// Double-click on a legend layer opens the legend editor (frmLayerSymbol) for that layer
if Not(IsCOMType(DIID_IMoMapLayer, Map1.Layers.Item(Index))) then
begin
ShowMessage(String('Sorry, you cannot set properties for an ImageLayer\r\n')+
String('Try setting properties for a Layer with vecor data'));
exit;
end;
MapLegend1.Active[Index] := true;
FLayerIndex := MapLegend1.GetActiveLayer;
FActiveLayer := Map1.Layers.Item(FLayerIndex);
// Invoke property sheet for new layer
frmLayerSymbol.ShowModal;
end;
//This function came from "van henknoort".
function TForm1.IsCOMType(TypeOfObject:TGUID;rObject:IDispatch):BOOL;
var
answer:BOOL;
status:HRESULT;
p:Pointer;
begin
answer := false;
if (rObject<>Nil) then
begin
p := Nil;
status := rObject.QueryInterface(TypeOfObject, p);
if ( SUCCEEDED(status) and (p<>nil)) then
begin
answer := true;
(IUnknown(p))._Release;
end
else
answer := false;
end;
result:= answer;
end;
{*****************************************************************************}
procedure TForm1.CoutiesClassBreaksRenderer;
var
//breakval : double;
r : IMoClassBreaksRenderer;
//stats : IMoStatistics;
//i : integer;
lyrs : IMoLayers;
lyr : IMoMapLayer;
rc : IMoRecordset;
begin
lyrs := IMoLayers(Map1.layers);
r := coClassBreaksRenderer.Create;
lyr := IMoMapLayer(lyrs.item('Counties'));
lyr.renderer := r;
r.field :='pop1990';
rc := IMoRecordset(lyr.records);
r.BreakCount := 5;
r.Break[0] := 141092;
r.Break[1] := 485765;
r.Break[2] := 1203789;
r.Break[3] := 2818199;
r.Break[4] := 8863164;
//create a color ramp
r.RampColors(8454143,$FF0000);
//Map1.refresh;
end;
{*****************************************************************************}
procedure TForm1.CountiesDotDensityRenderer;
var
//stats : IMoStatistics;
r1 : IMoDotDensityRenderer;
lyrs : IMoLayers;
lyr : IMoMapLayer;
//rc : IMoRecordset;
begin
lyrs := IMoLayers(Map1.layers);
lyr := IMoMapLayer(lyrs.item('counties'));
lyr.visible :=true;
//Can not set multiple dot density like ArcGIS - ArcView
r1 := coDotDensityRenderer.Create;
r1.field := 'pop1990';
r1.DotSize := 5;
r1.DotValue := 90000;
r1.DotColor := moBlue;
r1.DrawBackground := true;
lyr.renderer := r1;
end;
procedure TForm1.HighwayValueMapRender;
var
ly:IMoMapLayer;
vmrend:IMoValueMapRenderer;
begin
// set up renderer for the roads
ly := IMoMapLayer(Map1.Layers.item('ushigh'));
vmrend := coValueMapRenderer.Create;
ly.Renderer := vmrend;
vmrend.SymbolType := moLineSymbol;
vmrend.Field := 'admn_class';
// set the values
vmrend.ValueCount :=3;
vmrend.Value[0] := 'Interstate';
vmrend.Value[1] := 'State Highway';
vmrend.Value[2] := 'US Highway';
// set the symbols
vmrend.Symbol[0].Size :=2;
vmrend.Symbol[1].Size :=2;
vmrend.Symbol[2].Size :=1;
vmrend.Symbol[0].Color :=moRed;
vmrend.Symbol[1].Color :=moBlue;
vmrend.Symbol[2].Color :=moPurple;
//Map1.Refresh;
vmrend:=nil;
end;
procedure TForm1.StatesDotDensityRenderer;
var
ly : IMoMapLayer;
rend : IMoDotDensityRenderer;
stats : IMoStatistics;
begin
ly := IMoMapLayer(Map1.Layers.item('States'));
rend := coDotDensityRenderer.Create;
//stats := coStatistics.Create;
ly.Renderer := rend;
rend.Field := 'HOUSEHOLDS';
stats := ly.Records.CalculateStatistics('HOUSEHOLDS');
rend.DotValue := stats.Max / 40;
end;
procedure TForm1.Map1AfterLayerDraw(ASender: TObject; index: Smallint;
canceled: WordBool; hDC: Cardinal);
begin
//Map1.Refresh;
end;
//Test procedure for RenderClick event.
procedure TForm1.MapLegend1RenderClick(Sender: TObject; LayerIndex,
BreakIndex: Integer; val1, val2: Variant);
var
Msg : string;
lyr : IMoMapLayer;
begin
lyr := IMoMapLayer(Map1.Layers.Item(LayerIndex));
Msg := 'You click at layer "' + uppercase(lyr.Name) + '".' + #13#13 + 'Index of layer = ' + inttostr(LayerIndex) + '.' + #13;
Msg := Msg + 'Value 1 = ' + vartostr(val1) + #13;
Msg := Msg + 'Value 2 = ' + vartostr(val2);
ShowMessage(Msg);
end;
procedure TForm1.Memo1Click(Sender: TObject);
begin
Memo1.Hide;
end;
end.