www.pudn.com > MapLegend.rar > MoView2_LayerSymbol.pas
//This unit is activated when user double click at the layer of Legend.
//This unit is from Moview2 example. You can download full example at
//http://arcscripts.esri.com/details.asp?dbid=14019
unit MoView2_LayerSymbol;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, MapObjects2_TLB,
OleCtrls,ActiveX, Contnrs;
type
TFrmLayerSymbol = class(Tform)
Label1: TLabel;
txtLayerName: TEdit;
lblPanelDesc: TLabel;
sstLayerProp: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
lblSSP0: TLabel;
lblSSP6: TLabel;
lblSSP1: TLabel;
cboSSP0: TComboBox;
lblSSP2: TLabel;
txtSSP0: TEdit;
chkSSP: TCheckBox;
lblSSP3: TLabel;
cboSSP1: TComboBox;
lblSSP4: TLabel;
cboSSP2: TComboBox;
lblSSP5: TLabel;
hsbSSP: TScrollBar;
lblSSP7: TLabel;
cmdOK: TButton;
cmdCancel: TButton;
cmdApply: TButton;
Label11: TLabel;
cboUV: TComboBox;
cmdUV: TButton;
chkUV: TCheckBox;
Label13: TLabel;
cboCB0: TComboBox;
Label14: TLabel;
cboCB1: TComboBox;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
chkCB: TCheckBox;
cmdCB: TButton;
lblSL1: TLabel;
cboSL0: TComboBox;
lblSL2: TLabel;
cboSL1: TComboBox;
lblSL3: TLabel;
cboSL2: TComboBox;
lblSL4: TLabel;
txtSL: TEdit;
lblSL5: TLabel;
cboSL3: TComboBox;
chkSL0: TCheckBox;
CheckBox3: TCheckBox;
chkSL1: TCheckBox;
chkSL3: TCheckBox;
chkSL2: TCheckBox;
lblSL7: TLabel;
lblSL8: TLabel;
hsbSL: TScrollBar;
lblSL6: TLabel;
cboSL4: TComboBox;
cmdSL: TButton;
Label27: TLabel;
cboNOL: TComboBox;
cmdNOL: TButton;
Label28: TLabel;
txtNOL: TEdit;
fraNOL0: TRadioGroup;
optNOL0: TRadioButton;
optNOL1: TRadioButton;
optNOL2: TRadioButton;
chkNOL0: TCheckBox;
chkNOL1: TCheckBox;
chkNOL2: TCheckBox;
Label29: TLabel;
fraNOL3: TGroupBox;
hsbNOL: TScrollBar;
Label30: TLabel;
Label31: TLabel;
fraZR: TGroupBox;
Label33: TLabel;
cboZRClasses: TComboBox;
Label34: TLabel;
cboZRType: TComboBox;
Label35: TLabel;
Label36: TLabel;
Label37: TLabel;
cmdZR: TButton;
picLayerProp: TImage;
cdlFont: TFontDialog;
cdlColor: TColorDialog;
Label2: TLabel;
picZRRamp0: TEdit;
picZRRamp1: TEdit;
picSSP0: TStaticText;
picSSP1: TStaticText;
fraCBOuter: TGroupBox;
fraCBInner: TScrollBox;
picCBRamp0: TStaticText;
picCBRamp1: TStaticText;
picNOL: TStaticText;
fraUVOuter: TGroupBox;
fraUVInner: TScrollBox;
procedure cmdNOLClick(Sender:TObject);
procedure formCreate(Sender: TObject);
procedure cmdSLClick(Sender: TObject);
procedure cmdCBClick(Sender: TObject);
procedure cmdUVClick(Sender: TObject);
procedure cmdZRClick(Sender: TObject);
procedure cboSSP0Click(Sender: TObject);
procedure cboSSP1Click(Sender: TObject);
procedure hsbSSPChange(Sender: TObject);
procedure hsbSLScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure hsbSLChange(Sender: TObject);
procedure picCBRamp1Click(Sender: TObject);
procedure picNOLMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure picSSP0MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// procedure vsbUVChange(Sender: TObject);
procedure sstLayerPropChange(Sender: TObject);
procedure sstLayerPropChanging(Sender: TObject;
var AllowChange: Boolean);
procedure formDestroy(Sender: TObject);
procedure cmdApplyClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure cmdOKClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure picNOLClick(Sender: TObject);
procedure picSSP0Click(Sender: TObject);
procedure picCBRamp0Click(Sender: TObject);
private
{ Private declarations }
szMarkerStyle:array[0..4] of String;
szLineStyle:array [0..4] of String;
szFillStyle:array [0..10] of String;
szPanelDesc:array [0..5] of String;
lyr :IMoMapLayer;
recs :IMoRecordset;
tDesc:IMoTableDesc;
flds:IMoFields;
a:Integer;
vmr:IMoValueMapRenderer;
cbr:IMoClassBreaksRenderer;
lp:IMoLabelPlacer;
zRend:IMoZRenderer;
colorMask, colorText:longint;
justOpened :Boolean;
//Created and Stored these controls in TObjectList.
picCBLegends,lblCBLegends:TObjectList;
picUVs,lblUVs:TObjectList;
picZRLegends,lblZRLegends:TObjectList;
ap:integer;
procedure LoadSingleSymbol;
procedure LoadUniqueValues;
procedure LoadClassBreaks;
procedure LoadStandardLabels;
procedure LoadNoOverlapLabels;
procedure LoadZRenderer;
procedure PopulateNewUVlegend(rendField : String);
procedure PopulateNewCBlegend(rendField : String);
procedure PopulateNewZRLegend;
function IsCOMType(TypeOfObject:TGUID;rObject:IDispatch):BOOL;
procedure InitSingleSymbol;
procedure InitUniqueValues;
procedure InitClassBreaks;
procedure InitStandardLabels;
procedure InitNoOverLapLabels;
procedure InitZRenderer;
procedure PopulateExistingUVlegend;
procedure PopulateExistingCBlegend;
procedure PopulateExistingZRlegend;
procedure ApplySingleSymbol;
procedure ApplyUniqueValues;
procedure ApplyClassBreaks;
procedure ApplyStandardLabels;
procedure ApplyNoOverlapLabels;
procedure ApplyZRenderer;
public
{ Public declarations }
end;
var
FrmLayerSymbol: TFrmLayerSymbol;
implementation
uses Unit1;
{$R *.dfm}
procedure TFrmLayerSymbol.FormActivate(Sender: TObject);
begin
lyr := IMoMapLayer(form1.ActiveLayer);
Caption := 'Symbol properties for the ' + Uppercase(lyr.Name) + ' layer.';
recs := lyr.Records;
tDesc := recs.TableDesc;
flds := recs.Fields;
justOpened := True;
szPanelDesc[0] := 'The Single Symbol classification displays all the features in a layer with the same symbol.';
szPanelDesc[1] := 'The Unique Values classification displays features by applying a symbol to each unique value for a specified field.';
szPanelDesc[2] := 'The Class Breaks classification applies symbols to a set of discrete values.';
szPanelDesc[3] := 'The Standard Labels classification draws text for a specified field.';
szPanelDesc[4] := 'The No Overlapping Labels classication draws text for a specified field and attempts to resolve overlapping and crowding of labels.';
szPanelDesc[5] := 'The Elevation classification draws features according to their Z values, if the data supports it.';
txtLayerName.Text := lyr.Name;
szMarkerStyle[0] := 'Circle marker';
szMarkerStyle[1] := 'Square marker';
szMarkerStyle[2] := 'Triangle marker';
szMarkerStyle[3] := 'Cross marker';
szMarkerStyle[4] := 'TrueType marker';
szLineStyle[0] := 'Solid line';
szLineStyle[1] := 'Dash line';
szLineStyle[2] := 'Dot line';
szLineStyle[3] := 'Dash dot line';
szLineStyle[4] := 'Dash dot dot line';
szFillStyle[0] := 'Solid fill';
szFillStyle[1] := 'Transparent fill';
szFillStyle[2] := 'Horizontal fill';
szFillStyle[3] := 'Vertical fill';
szFillStyle[4] := 'Upward diagonal';
szFillStyle[5] := 'Downward diagonal';
szFillStyle[6] := 'Cross fill';
szFillStyle[7] := 'Diagonal cross fill';
szFillStyle[8] := 'Light gray fill';
szFillStyle[9] := 'Gray fill';
szFillStyle[10] := 'Dark gray fill';
//Read the contents of the active layer's Renderer property.
//Run one of the "Load..." procedures to populate the appropriate
//tab with the current renderer's properties.
if (lyr.Renderer=NIL) then
begin
sstLayerProp.ActivePageIndex := 0;
LoadSingleSymbol;
end
else if (IsComType(DIID_IMoValueMapRenderer,IDispatch(lyr.Renderer))) then
begin
sstLayerProp.ActivePageIndex := 1;
LoadUniqueValues;
end
else if (IsComType(DIID_IMoClassBreaksRenderer,IDISPATCH(lyr.Renderer))) then
begin
sstLayerProp.ActivePageIndex := 2;
LoadClassBreaks;
end
else if (IsComType(DIID_IMoLabelRenderer,IDISPATCH(lyr.Renderer))) then
begin
sstLayerProp.ActivePageIndex := 3;
LoadStandardLabels;
end
else if (IsComType(DIID_IMoLabelPlacer,IDISPATCH(lyr.Renderer))) then
begin
sstLayerProp.ActivePageIndex := 4;
colorMask := IMoLabelPlacer(lyr.Renderer).MaskColor;
LoadNoOverlapLabels;
end
else if (IsComType(DIID_IMoZRenderer,IDISPATCH(lyr.Renderer))) then
begin
sstLayerProp.ActivePageIndex := 5;
LoadZRenderer;
end
else
begin
sstLayerProp.ActivePageIndex := 0;
LoadSingleSymbol
end;
//if the active layer does not support Z shapes, disable
//the "Elevation" rendering tab.
if (Pos('[SHAPEFILZ]',lyr.tag) = 0) and (Pos('[SDEZ]',lyr.tag) = 0) then
sstLayerProp.Pages[5].Enabled:=false;
end;
procedure TFrmLayerSymbol.formCreate(Sender: TObject);
var
pic:TPicture;
picUV,picCB,picZR:TStaticText;
lblUV,lblCB,lblZR:TLabel;
begin
//Hold on control for Unique Value
picUVs:=TObjectList.Create;
lblUVs:=TObjectList.Create;
picUV:=TStaticText.Create(fraUVinner);
with picUV do
begin
Parent:=fraUVinner;
Height:=13;
Left:=8;
Top:=10;
Width:=17;
end;
lblUV:=TLabel.Create(fraUVinner);
with lblUV do
begin
Parent:=fraUVinner;
Height:=13;
Left:=32;
Top:=10;
Width:=97;
Caption:='Legend label';
end;
picUVs.Add(picUV);
lblUVs.Add(lblUV);
//Hold on control for Classbreaker
picCBLegends:=TObjectList.Create;
lblCBLegends:=TObjectList.Create;
picCB:=TStaticText.Create(fraCBInner);
with picCB do
begin
Parent:=fraCBInner;
Height:=13;
Left:=8;
Top:=20;
Width:=17;
end;
lblCB:=TLabel.Create(fraCBInner);
with lblCB do
begin
Parent:=fraCBInner;
Height:=13;
Left:=32;
Top:=20;
Width:=97;
Caption:='';
end;
picCBLegends.Add(picCB);
lblCBLegends.Add(lblCB);
//Hold on control for ZRenderer
picZRLegends:=TObjectList.Create;
lblZRLegends:=TObjectList.Create;
picZR:=TStaticText.Create(fraZR);
with picZR do
begin
Parent:=fraZR;
Height:=13;
Left:=8;
Top:=20;
Width:=17;
end;
lblZR:=TLabel.Create(fraZR);
with lblZR do
begin
Parent:=fraZR;
Height:=13;
Left:=32;
Top:=20;
Width:=97;
Caption:='';
end;
picZRLegends.Add(picZR);
lblZRLegends.Add(lblZR);
//Position this form into the top right
//corner of the screen
pic:=TPicture.Create;
Top := 0;
Left := Screen.Width - Width;
colorText := moBlack;
colorMask := moWhite;
pic.LoadFromFile(ExtractFilePath(Application.ExeName) + '\class.bmp');
picLayerProp.Picture := pic;
//pic.free;
end;
procedure TFrmLayerSymbol.formDestroy(Sender: TObject);
var
picUV,picCB,picZR:TStaticText;
lblUV,lblCB,lblZR:TLabel;
i : integer;
begin
for i := picUVs.Count - 1 to 0 do
begin
picUV:=TStaticText(PicUVs[i]);
lblUV:=TLabel(lblUVs[i]);
fraUVInner.RemoveControl(picUV);
fraUVInner.RemoveControl(lblUV);
picUVs.Remove(picUV);
lblUVs.Remove(lblUV);
//picUV.Free;
//lblUV.Free;
end;
picUVs.Free;
lblUVs.Free;
for i := picCBLegends.Count - 1 to 0 do
begin
picCB:=TStaticText(picCBLegends[i]);
lblCB:=TLabel(lblCBLegends[i]);
fraCBInner.RemoveControl(picCB);
fraCBInner.RemoveControl(lblCB);
picCBLegends.Remove(picCB);
lblCBLegends.Remove(lblCB);
//picCB.Free;
//lblCB.Free;
end;
picCBLegends.Free;
lblCBLegends.Free;
for i := picZRLegends.Count - 1 to 0 do
begin
picZR:=TStaticText(picZRLegends[i]);
lblZR:=TLabel(lblZRLegends[i]);
fraZR.RemoveControl(picZR);
fraZR.RemoveControl(lblZR);
picZRLegends.Remove(picZR);
lblZRLegends.Remove(lblZR);
//picZR.Free;
//lblZR.Free;
end;
picZRLegends.Free;
lblZRLegends.Free;
end;
//cboNOL
function TFrmLayerSymbol.IsCOMType(TypeOfObject:TGUID;rObject:IDispatch):BOOL;
// this function checks the type of object that is stored in Object;
// it can be used for checking the coordinate system of Maps and Layers;
// these objects DO have a CoordinateSystem property(OleVariant) but
// this property cannot not be approached without KNOWING whether it
// is a GeoCoordSys or a ProjCoordSys object!!!!!
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 TFrmLayerSymbol.cmdApplyClick(Sender : TObject);
//When the user hits the Apply button (or the OK button)
//read the option controls on the active tab, and use
//them to build a new renderer with which to draw the layer.
begin
Case sstLayerProp.ActivePageIndex of
0:ApplySingleSymbol;
1:ApplyUniqueValues;
2:ApplyClassBreaks;
3:ApplyStandardLabels;
4:ApplyNoOverlapLabels;
5:ApplyZRenderer;
end;
//Rename the layer with the contents of txtLayerName.Text
lyr.Name := txtLayerName.text;
form1.MapLegend1.LoadLegend;
form1.Map1.Refresh;
end;
procedure TFrmLayerSymbol.cmdOKClick(Sender : TObject);
//Use Apply then close this form.
begin
cmdApplyClick(Sender);
Close;
end;
procedure TFrmLayerSymbol.cmdCancelClick(Sender:TObject);
begin
//Throw away all work on this form.
//Layer retains original rendering information.
Close;
end;
procedure TFrmLayerSymbol.cmdNOLClick(Sender:TObject);
begin
//Choose font properties for the LabelPlacer
cdlFont.Device:=fdBoth;
cdlFont.Font.Color := TColor(ColorText);
if (cdlFont.Execute) then
begin
txtNOL.Font.Name := cdlFont.Font.Name;
txtNOL.Font.Style:=cdlFont.Font.Style;
txtNOL.Font.Color:=cdlFont.Font.Color;
// txtNOL.Font:=cdlFont.Font;
txtNOL.text := cdlFont.Font.Name;
colorText := cdlFont.Font.color;
end;
end;
Procedure TFrmLayerSymbol.cmdSLClick(Sender:TObject);
//Choose font properties for the LabelRenderer
begin
cdlFont.Device := fdBoth;//cdlCFEffects Or cdlCFBoth
if (cdlFont.Execute) then
begin
txtSL.Font.Color := cdlFont.Font.color;
txtSL.text := cdlFont.Font.Name;
end;
end;
procedure TFrmLayerSymbol.cmdCBClick(Sender:TObject);
//Build a new tentative class breaks legend
begin
PopulateNewCBlegend(cboCB1.text);
cmdApply.Enabled := True;
cmdOK.Enabled := True;
end;
procedure TFrmLayerSymbol.cmdUVClick(Sender:TObject);
//Build a new tentative unique values legend
begin
PopulateNewUVlegend(cboUV.text);
cmdApply.Enabled := True;
cmdOK.Enabled := True;
end;
procedure TFrmLayerSymbol.cmdZRClick(Sender:TObject);
//Build a new tentative Z elevation breaks legend
begin
PopulateNewZRLegend;
cmdApply.Enabled := True;
cmdOK.Enabled := True;
end;
procedure TFrmLayerSymbol.cboSSP0Click(Sender:TObject);
var
fnt:TFont;
i:integer;
begin
fnt:=TFont.Create;
// choose single symbol style
if (cboSSP0.text = 'TrueType marker') then
begin
cboSSP1.Enabled := True;
cboSSP2.Enabled := True;
lblSSP3.Enabled := True;
lblSSP4.Enabled := True;
lblSSP5.Enabled := True;
lblSSP7.Enabled := True;
hsbSSP.Enabled := True;
for i := 0 to Screen.Fonts.Count - 1 do
cboSSP1.Items.Add (Screen.Fonts.Strings[i]);
cboSSP1.ItemIndex:=0;//.ItemIndex := 0;
fnt.Name := cboSSP1.text;
cboSSP2.Font := fnt;
cboSSP2.Clear;
for i := 0 to 255 do
cboSSP2.Items.Add (Chr(i));
end
else //if not TT font, then disable controls specific to TT fonts
begin
cboSSP1.Clear;
cboSSP2.Clear;
cboSSP1.Enabled := False;
cboSSP2.Enabled := False;
lblSSP3.Enabled := False;
lblSSP4.Enabled := False;
lblSSP5.Enabled := False;
lblSSP7.Enabled := False;
hsbSSP.Enabled := False;
end;
fnt.Free;
end;
procedure TFrmLayerSymbol.cboSSP1Click(Sender:TObject);
var
fnt:TFont;
i:integer;
begin
fnt:=TFont.Create;
//populate combobox list of TT font glyphs in the chosen font
cboSSP2.Clear;
fnt.Name := cboSSP1.text;
cboSSP2.Font := fnt;
for i := 0 to 255 do
cboSSP2.Items.Add(Chr(i));
fnt.Free;
end;
procedure TFrmLayerSymbol.hsbSSPChange(Sender:TObject);
//Sets the rotation on a single symbol point marker
//that is using a TT font
begin
lblSSP7.Caption := inttostr(hsbSSP.Position);
end;
procedure TFrmLayerSymbol.hsbSLScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
//Sets the rotation on standard label text
begin
lblSL8.Caption := inttostr(hsbSL.position);
end;
procedure TFrmLayerSymbol.hsbSLChange(Sender:TObject);
//Sets the rotation on standard label text
begin
lblSL8.Caption := inttostr(hsbSL.position);
end;
procedure TFrmLayerSymbol.picCBRamp1Click(Sender: TObject);
//Sets start and stop ramp colors for class breaks renderer
begin
if (cdlColor.Execute) then
picCBramp1.Color:= cdlColor.Color;
end;
procedure TFrmLayerSymbol.picNOLMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
//User changes the MaskColor of the LabelPlacer
begin
if (colorMask <> moWhite) then
cdlColor.color := colorMask;
if(cdlColor.Execute) then
begin
picNOL.Color := cdlColor.Color;
colorMask := cdlColor.Color;
end;
//Turn on the MaskLabels check box
chkNOL1.Checked := true;
end;
procedure TFrmLayerSymbol.picSSP0MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
//Sets the color for single symbol rendering
begin
cdlColor.Color:=picSSP1.Brush.Color;
cdlColor.Execute;
picSSP1.Brush.Color := cdlColor.color;
end;
procedure TFrmLayerSymbol.sstLayerPropChanging(Sender: TObject;
var AllowChange: Boolean);
begin
ap:=sstLayerProp.ActivepageIndex;
end;
procedure TFrmLayerSymbol.sstLayerPropChange(Sender:TObject);
var
lyrRend:IDispatch;
pt:IMoPoint;
fPageChanged:BOOL;
i:longint;
begin
fPageChanged:=false;
for i:=0 to sstLayerProp.PageCount-1 do
begin
if(i=sstLayerProp.ActivePageIndex) then
if(sstLayerProp.Pages[i].Enabled) then
begin
sstLayerProp.Pages[i].Highlighted:=true;
fPageChanged:=true;
end
else
begin
sstLayerProp.ActivePageIndex:=ap;
sstLayerProp.Pages[ap].Highlighted:=true;
end
else
sstLayerProp.Pages[i].Highlighted:=false;
end;
if not(fPageChanged) then exit;
//When the user clicks one of the renderer tabs, determine
//whether the active layer is already using that type of
//renderer. then...
// ...if it is, then read the properties of that layer and
// use those properties to load the various option
// controls on that tab. Use one of the "Load..." procedures.
// ...or if it is not, then load the various option controls
// controls on that tab with some default values. Use
// one of the "Init..." procedures.
pt:=coPoint.Create;
if(IDISPATCH(lyr.Renderer)=NIL) then
lyrRend:=pt
else
lyrRend:=lyr.Renderer;
case sstLayerProp.ActivePageIndex of
0://Single Symbol Tabsheet
if(IsComType(DIID_IMoPoint,lyrRend)) then
InitSingleSymbol
else
LoadSingleSymbol;
1://ValueMapRenderer Tabsheet
if(IsComType(DIID_IMoValueMapRenderer,lyrRend)) then
LoadUniqueValues
else
InitUniqueValues;
2://ClassBreaksRenderer Tabsheet
if(IsComType(DIID_IMoClassBreaksRenderer,lyrRend)) then
LoadClassBreaks
else
InitClassBreaks;
3://LabelRenderer Tabsheet
if (IsComType(DIID_IMoLabelRenderer,lyrRend)) then
LoadStandardLabels
else
InitStandardLabels;
4://LabelPlacer Tabsheet
if (IsComType(DIID_IMoLabelPlacer,lyrRend)) then
LoadNoOverlapLabels
else
InitNoOverlapLabels;
5://ZRenderer Tabsheet
if(IsComType(DIID_IMoZRenderer,lyrRend)) then
LoadZRenderer
else
InitZRenderer;
end;
end;
//THE SIX PROCEDURES THAT FOLLOW, THAT BEGIN WITH THE WORD "INIT..."
//ARE THOSE THAT RUN WHEN A RENDERER IS CHOSEN WHICH DOES NOT
//COINCIDE WITH THE ACTIVE LAYER'S CURRENT RENDERER. THE OPTION
//CONTROLS ON THAT TAB ARE LOADED WITH DEFAULT VALUES THAT THE USER
//CAN CHANGE.
// InitSingleSymbol()
// InitUniqueValues()
// InitClassBreaks()
// InitStandardLabels()
// InitNoOverlapLabels()
// InitZRenderer()
procedure TFrmLayerSymbol.InitSingleSymbol;
var
i:Integer;
// fnt:TFont;
begin
cboSSP1.Clear;
Case Lyr.shapeType of
moShapeTypePoint:
begin
//set control visibility
cboSSP1.Visible := true;
cboSSP2.Visible:=true;
chkSSP.Visible := False;
hsbSSP.Visible := True;
picSSP1.Visible := False;
lblSSP3.Visible := True;
lblSSP4.Visible := True;
lblSSP5.Visible := True;
lblSSP6.Visible := False;
lblSSP7.Visible := True;
//retrieve and display current values
txtSSP0.text := '5';
lblSSP1.Caption := 'Marker Color:';
lblSSP3.Caption := 'Size:';
for i := 0 to 4 do
cboSSP1.Items.Add (szMarkerStyle[i]);
picSSP0.Brush.Color := moGreen;
cboSSP1.text := szMarkerStyle[moSquareMarker];
cboSSP2.ItemIndex := 1;
hsbSSP.Position := 0;
lblSSP7.Caption := '0';
cboSSP1.Enabled := False;
cboSSP2.Enabled := False;
lblSSP3.Enabled := False;
lblSSP4.Enabled := False;
lblSSP5.Enabled := False;
lblSSP7.Enabled := False;
hsbSSP.Enabled := False;
end;
moShapeTypeMultipoint:
//set control visibility
begin
cboSSP1.Visible := True;
cboSSP2.Visible := True;
chkSSP.Visible := False;
hsbSSP.Visible := True;
picSSP1.Visible := False;
lblSSP3.Visible := True;
lblSSP4.Visible := True;
lblSSP5.Visible := True;
lblSSP6.Visible := False;
lblSSP7.Visible := True;
//retrieve and display current values
txtSSP0.text := '5';
lblSSP0.Caption := 'Marker Color:';
lblSSP2.Caption := 'Size:';
for i := 0 to 4 do
cboSSP0.items.Add(szMarkerStyle[i]);
picSSP0.Brush.Color := moGreen;
cboSSP0.text := szMarkerStyle[moSquareMarker];
cboSSP0.ItemIndex := 1;
hsbSSP.Position := 0;
lblSSP7.Caption := '0';
cboSSP1.Enabled := False;
cboSSP2.Enabled := False;
lblSSP3.Enabled := False;
lblSSP4.Enabled := False;
lblSSP5.Enabled := False;
lblSSP7.Enabled := False;
hsbSSP.Enabled := False;
end;
moLine:
//set visibility
begin
cboSSP1.Visible := False;
cboSSP2.Visible := False;
chkSSP.Visible := False;
hsbSSP.Visible := False;
picSSP1.Visible := False;
lblSSP3.Visible := False;
lblSSP4.Visible := False;
lblSSP5.Visible := False;
lblSSP6.Visible := False;
lblSSP7.Visible := False;
//retrieve and display current values
txtSSP0.text := '1';
lblSSP0.Caption := 'Line Color:';
lblSSP2.Caption := 'Line width:';
for i := 0 to 4 do
cboSSP0.Items.Add(szLineStyle[i]);
picSSP0.Brush.Color := moBlue;
cboSSP0.text := szLineStyle[0];
cboSSP0.ItemIndex := 0;
end;
moPolygon:
//set visibility
begin
cboSSP1.Visible := False;
cboSSP2.Visible := False;
chkSSP.Visible := True;
hsbSSP.Visible := False;
picSSP1.Visible := True;
lblSSP3.Visible := False;
lblSSP4.Visible := False;
lblSSP5.Visible := False;
lblSSP6.Visible := True;
lblSSP7.Visible := False;
//retrieve and display current values
txtSSP0.text := '1';
lblSSP0.Caption := 'Fill Color:';
lblSSP2.Caption := 'Outline width:';
for i := 0 to 10 do
cboSSP0.Items.Add(szFillStyle[i]);
picSSP0.Brush.Color := moLightGray;
picSSP1.Brush.Color := moBlack;
cboSSP0.text := szFillStyle[0];
cboSSP0.ItemIndex := 0;
chkSSP.Checked := true;
end;
end;
cmdApply.Enabled := True;
cmdOK.Enabled := True;
end;
procedure TFrmLayerSymbol.InitUniqueValues;
var
i:Integer;
cntrl1,cntrl2:TControl;
//Load ComboBox with layer field names
begin
cboUV.Clear;
for i := 0 to tDesc.FieldCount - 1 do
cboUV.Items.Add(tDesc.FieldName[i]);
cboUV.ItemIndex := 0;
fraUVouter.Caption := 'Legend Preview';
fraUVInner.Visible := false;
//if a legend already exists, unload it
if (picUVs.Count > 1) then
for i := (picUVs.count - 1) downto 1 do
begin
cntrl1:=TControl(picUVs[i]);
cntrl2:=TControl(lblUVs[i]);
fraUVInner.RemoveControl(cntrl1);
fraUVInner.RemoveControl(cntrl2);
picUVs.Remove(cntrl1);
lblUVs.Remove(cntrl2);
//TStaticText(cntrl1).Free;
//TLabel(cntrl2).Free;
end;
fraUVInner.Visible := true;
lblUVs.Capacity := lblUVs.Count;
picUVs.Capacity := picUVs.Count;
cntrl1:=TControl(picUVs[0]);
cntrl2:=TControl(lblUVs[0]);
TStaticText(cntrl1).Visible:=False;
TLabel(cntrl2).Visible:=false;
cmdApply.Enabled := False;
cmdOK.Enabled := False;
chkUV.Visible:=(lyr.shapeType=moShapeTypePolygon);
end;
Procedure TFrmLayerSymbol.InitClassBreaks;
var
i:Integer;
fld:IMoField;
cntrl1,cntrl2:TControl;
begin
//Clear and reload ComboBoxes
cboCB0.Clear;
cboCB0.Items.Add('FeatureID');
cboCB1.ItemIndex := 3;
for i := 0 to tDesc.FieldCount - 1 do
begin
fld := flds.Item(tDesc.FieldName[i]);
if (fld.Type_ = moDouble) Or (fld.Type_ = moLong) then
cboCB0.Items.Add(fld.Name);
end;
cboCB0.ItemIndex:=0;
fraCBInner.Visible := false;
//if a legend already exists, unload it
if (picCBlegends.count > 1) then
begin
for i := (picCBlegends.count - 1) downto 1 do
begin
cntrl1:=TControl(picCBlegends[i]);
cntrl2:=TControl(lblCBLegends[i]);
fraCBInner.RemoveControl(cntrl1);
fraCBInner.RemoveControl(cntrl2);
picCBlegends.Remove(cntrl1);
lblCBLegends.Remove(cntrl2);
end;
end;
fraCBInner.Visible := true;
picCBLegends.Capacity := picCBLegends.Count;
lblCBLegends.Capacity := lblCBLegends.Count;
fraCBOuter.Caption:='';
cntrl1:=TControl(picCBlegends[0]);
cntrl2:=TControl(lblCBLegends[0]);
TStaticText(cntrl1).Visible:=False;
TLabel(cntrl2).Visible:=false;
cmdApply.Enabled := False;
cmdOK.Enabled := False;
if (lyr.shapeType = moShapeTypePolygon) then
chkCB.Visible :=true
else
chkCB.Visible:=false;
end;
procedure TFrmLayerSymbol.InitStandardLabels;
var
i:Integer;
begin
for i := 0 To tDesc.FieldCount - 1 do
begin
cboSL0.Items.Add(tDesc.FieldName[i]);
if (tDesc.FieldType[i] = moLong) Or (tDesc.FieldType[i] = moDouble) then
begin
cboSL3.Items.Add(tDesc.FieldName[i]);
cboSL4.Items.Add(tDesc.FieldName[i]);
end;
end;
cboSL0.ItemIndex := 0;
cboSL1.ItemIndex := 1;
cboSL2.ItemIndex := 1;
cdlFont.Font.Name := 'MS Sans Serif';
cdlFont.Font.Size := 10;
cdlFont.Font.Style := [];
cdlFont.Font.Color := moBlack;
cmdApply.Enabled := True;
cmdOK.Enabled := True;
end;
procedure TFrmLayerSymbol.InitNoOverlapLabels;
var
i:Integer;
//scaleHeightUnit:Double;
begin
cboNOL.Clear;
for i := 0 to tDesc.FieldCount - 1 do
cboNOL.Items.Add(tDesc.FieldName[i]);
cboNOL.ItemIndex := 0;
cdlFont.Font.Name := 'MS Sans Serif';
cdlFont.Font.Size := 10;
cdlFont.Font.Style := [];
cdlFont.Font.color := moBlack;
cmdApply.Enabled := True;
cmdOK.Enabled := True;
if (lyr.shapeType <> moShapeTypePolygon) then
fraNOL0.Enabled :=true
else
fraNOL0.Enabled:=false;
if (lyr.shapeType <> moShapeTypePolygon) then
begin
optNOL0.Enabled :=true;
optNOL1.Enabled :=true;
optNOL2.Enabled :=true;
end
else
begin
optNOL0.Enabled:=false;
optNOL1.Enabled:=false;
optNOL2.Enabled:=false;
end;
end;
procedure TFrmLayerSymbol.InitZRenderer;
var
i:Integer;
cntrl1,cntrl2:TControl;
begin
if (picZRLegends.count > 1) then
begin
fraZR.Visible := false;
for i := (picZRlegends.count - 1) downto 1 do
begin
cntrl1:=TControl(picZRlegends[i]);
cntrl2:=TControl(lblZRLegends[i]);
fraZR.RemoveControl(cntrl1);
fraZR.RemoveControl(cntrl2);
picZRlegends.Remove(cntrl1);
lblZRLegends.Remove(cntrl2);
//TStaticText(cntrl1).Free;
//TLabel(cntrl2).Free;
end;
fraZR.Visible := true;
end;
picZRLegends.Capacity := picZRLegends.Count;
lblZRLegends.Capacity := lblZRLegends.Count;
cntrl1:=TControl(picZRlegends[0]);
cntrl2:=TControl(lblZRLegends[0]);
TStaticText(cntrl1).Visible:=False;
TLabel(cntrl2).Visible:=false;
cmdApply.Enabled := False;
cmdOK.Enabled := False;
end;
//THE SIX PROCEDURES THAT FOLLOW, THAT BEGIN WITH THE WORD "LOAD..."
//ARE THOSE THAT RUN WHEN A RENDERER IS CHOSEN WHICH COINCIDES
//WITH THE ACTIVE LAYER'S CURRENT RENDERER. THE PROPERTIES OF
//THAT RENDERER ARE LOADED INTO THE OPTION CONTROLS ON THAT
//RENDERER'S FORM. THE USER CAN CHANGE THEM AT THAT POINT.
// LoadSingleSymbol()
// LoadUniqueValues()
// LoadClassBreaks()
// LoadStandardLabels()
// LoadNoOverlapLabels()
// LoadZRenderer()
procedure TFrmLayerSymbol.LoadSingleSymbol;
var
i:Integer;
fnt,stdfont:TFont;
pfnt:IDispatch;
begin
fnt:=TFont.Create;
cboSSP0.Clear;
Case (lyr.shapeType) of
moShapeTypePoint:
//set control visibility
begin
cboSSP1.Visible := True;
cboSSP2.Visible := True;
chkSSP.Visible := False;
hsbSSP.Visible := True;
picSSP1.Visible := False;
lblSSP3.Visible := True;
lblSSP4.Visible := True;
lblSSP5.Visible := True;
lblSSP6.Visible := False;
lblSSP7.Visible := True;
//retrieve and display current values
txtSSP0.text := inttostr(lyr.Symbol.Size);
lblSSP0.Caption := 'Marker Color:';
lblSSP2.Caption := 'Size:';
for i := 0 to 4 do
cboSSP0.Items.Add(szMarkerStyle[i]);
picSSP0.Color := lyr.Symbol.color;
cboSSP0.text := szMarkerStyle[lyr.Symbol.style];
cboSSP0.ItemIndex := lyr.Symbol.style;
hsbSSP.Position := trunc(lyr.Symbol.Rotation);
lblSSP7.Caption := inttostr(trunc(lyr.Symbol.Rotation));
if (lyr.Symbol.style = moTrueTypeMarker) then
begin
cboSSP1.Enabled := True;
cboSSP2.Enabled := True;
lblSSP3.Enabled := True;
lblSSP4.Enabled := True;
lblSSP5.Enabled := True;
lblSSP7.Enabled := True;
hsbSSP.Enabled := True;
for i := 0 to Screen.Fonts.Count - 1 do
cboSSP1.Items.Add(Screen.Fonts.Strings[i]);
//convert the OleFont to standard font
pfnt:=IDispatch(lyr.Symbol.Font);
stdFont:=TFont.Create;
OleFontToFont(IDispatch(pfnt),stdFont);
cboSSP1.text := stdFont.Name;
stdFont.Free;
fnt.Name := cboSSP1.text;
cboSSP2.Font := fnt;
cboSSP2.Clear;
for i := 0 to 255 do
cboSSP2.items.Add(Chr(i));
cboSSP2.text := inttostr(lyr.Symbol.CharacterIndex);
cboSSP2.ItemIndex := lyr.Symbol.CharacterIndex;
end;
end;
moShapeTypeMultipoint:
//set control visibility
begin
cboSSP1.Visible := True;
cboSSP2.Visible := True;
chkSSP.Visible := False;
hsbSSP.Visible := True;
picSSP1.Visible := False;
lblSSP3.Visible := True;
lblSSP4.Visible := True;
lblSSP5.Visible := True;
lblSSP6.Visible := False;
lblSSP7.Visible := True;
//retrieve and display current values
txtSSP0.text := inttostr(lyr.Symbol.Size);
lblSSP0.Caption := 'Marker Color:';
lblSSP2.Caption := 'Size:';
for i := 0 To 4 do
cboSSP0.Items.Add(szMarkerStyle[i]);
picSSP0.Color := lyr.Symbol.color;
cboSSP0.text := szMarkerStyle[lyr.Symbol.style];
cboSSP0.ItemIndex := lyr.Symbol.style;
hsbSSP.Position := trunc(lyr.Symbol.Rotation);
lblSSP7.Caption := inttostr(trunc(lyr.Symbol.Rotation));
if (lyr.Symbol.style = moTrueTypeMarker) then
begin
cboSSP1.Enabled := True;
cboSSP2.Enabled := True;
lblSSP3.Enabled := True;
lblSSP4.Enabled := True;
lblSSP5.Enabled := True;
lblSSP7.Enabled := True;
hsbSSP.Enabled := True;
for i := 0 To Screen.Fonts.Count - 1 do
cboSSP1.Items.Add(Screen.Fonts.Strings[i]);
//convert the OleFont to standard font
pfnt:=IDispatch(lyr.Symbol.Font);
stdFont:=TFont.Create;
OleFontToFont(IDispatch(pfnt),stdFont);
cboSSP1.text := stdFont.Name;
stdFont.Free;
for i := 0 to cboSSP1.Items.Count - 1 do
if (cboSSP1.Items.Strings[1] = cboSSP1.text) then
begin
cboSSP1.ItemIndex := 1;
break;
end;
end;
fnt.Name := cboSSP1.text;
cboSSP2.Font := fnt;
cboSSP2.Clear;
for i := 0 to 255 do
cboSSP2.items.Add(Chr(i));
cboSSP2.text := inttostr(lyr.Symbol.CharacterIndex);
cboSSP2.ItemIndex:= lyr.Symbol.CharacterIndex;
end;
moShapeTypeLine:
//set visibility
begin
cboSSP1.Visible := False;
cboSSP2.Visible := False;
chkSSP.Visible := False;
hsbSSP.Visible := False;
picSSP1.Visible := False;
lblSSP3.Visible := False;
lblSSP4.Visible := False;
lblSSP5.Visible := False;
lblSSP6.Visible := False;
lblSSP7.Visible := False;
//retrieve and display current values
txtSSP0.text := inttostr(lyr.Symbol.Size);
lblSSP0.Caption := 'Line Color:';
lblSSP2.Caption := 'Line width:';
for i := 0 to 4 do
cboSSP0.Items.Add(szLineStyle[i]);
picSSP0.Color := lyr.Symbol.color;
cboSSP0.text := szLineStyle[lyr.Symbol.style];
cboSSP0.ItemIndex := lyr.Symbol.style;
end;
moShapeTypePolygon:
//set visibility
begin
cboSSP1.Visible := False;
cboSSP2.Visible := False;
chkSSP.Visible := True;
hsbSSP.Visible := False;
picSSP1.Visible := True;
lblSSP3.Visible := False;
lblSSP4.Visible := False;
lblSSP5.Visible := False;
lblSSP6.Visible := True;
lblSSP7.Visible := False;
//retrieve and display current values
if (lyr.Symbol.Size = 0) then
txtSSP0.text := '1'
else
txtSSP0.text := inttostr(lyr.Symbol.Size);
lblSSP0.Caption := 'Fill Color:';
lblSSP2.Caption := 'Outline width:';
for i := 0 to 10 do
cboSSP0.Items.Add(szFillStyle[i]);
picSSP0.Color := lyr.Symbol.color;
picSSP1.Color := lyr.Symbol.OutlineColor;
cboSSP0.text := szFillStyle[lyr.Symbol.style];
cboSSP0.ItemIndex := lyr.Symbol.style;
case (lyr.Symbol.Outline) of
True: chkSSP.Checked := true;
False: chkSSP.Checked := false;
end;
end;
end;
end;
procedure TFrmLayerSymbol.LoadUniqueValues;
var
i:Integer;
// vmr:IMoValueMapRenderer;
begin
vmr := lyr.Renderer as IMoValueMapRenderer;
cboUV.Clear;
cboUV.text := vmr.Field;
for i := 0 to tDesc.FieldCount - 1 do
begin
cboUV.Items.Add(tDesc.FieldName[i]);
if (tDesc.FieldName[i] = vmr.Field) then
cboUV.ItemIndex := i;
end;
Case (vmr.Symbol[0].Outline) of
True: chkUV.Checked := true;
False: chkUV.Checked := false;
end;
if (lyr.shapeType = moShapeTypePolygon) then
chkUV.Visible :=true
else
chkUV.Visible:=false;
PopulateExistingUVlegend;
end;
procedure TFrmLayerSymbol.LoadClassBreaks;
var
i, j : Integer;
begin
cbr := lyr.Renderer as IMoClassBreaksRenderer;
j := -1;
cboCB0.Clear;;
cboCB0.text := cbr.Field;
for i := 0 to tDesc.FieldCount - 1 do
begin
if (tDesc.FieldType[i] = moDouble) Or (tDesc.FieldType[i] = moLong) then
begin
inc(j);
cboCB0.Items.Add(tDesc.FieldName[i]);
if (tDesc.FieldName[i] = cbr.Field) then
cboCB0.ItemIndex := j;
end;
end;
cboCB1.text := inttostr(cbr.BreakCount + 1);
cboCB1.ItemIndex := cbr.BreakCount;// - 1;
case (cbr.Symbol[0].Outline) of
True:
chkCB.Checked := true;
False:
chkCB.Checked := false;
end;
picCBramp0.Color := cbr.Symbol[0].color;
picCBramp1.Color := cbr.Symbol[cbr.BreakCount].color;
chkCB.Visible := (lyr.shapeType = moShapeTypePolygon);
PopulateExistingCBlegend;
end;
procedure TFrmLayerSymbol.LoadStandardLabels;
var
i : Integer;
strFN : String;
pfnt:IDispatch;
stdFont:TFont;
lr:IMoLabelRenderer;
dFnt:IFontDisp;
// txtsym:IMoTextSymbol;
begin
lr := lyr.Renderer as IMoLabelRenderer;
for i := 0 to tDesc.FieldCount - 1 do
begin
strFN := tDesc.FieldName[i];
cboSL0.Items.Add(strFN);
if (lr.Field = strFN) then
cboSL0.ItemIndex := i;
if (tDesc.FieldType[i] = moLong) Or (tDesc.FieldType[i] = moDouble) then
begin
cboSL3.Items.Add(strFN);
if (lr.XOffsetField = strFN) then
cboSL3.ItemIndex := i;
cboSL4.Items.Add(strFN);
if (lr.YOffsetField = strFN) then
cboSL4.ItemIndex := i;
end;
end;
case (lr.Symbol[0].HorizontalAlignment) of
moAlignLeft:
cboSL1.ItemIndex := 0;
moAlignCenter:
cboSL1.ItemIndex := 1;
moAlignRight:
cboSL1.ItemIndex := 2;
end;
case (lr.Symbol[0].VerticalAlignment) of
moAlignTop:
cboSL2.ItemIndex := 0;
moAlignCenter:
cboSL2.ItemIndex := 1;
moAlignBottom:
cboSL2.ItemIndex := 2;
end;
hsbSL.Position := trunc(lr.Symbol[0].Rotation);
lblSL7.Caption := inttostr(trunc(lr.Symbol[0].Rotation));
chkSL0.Checked := false;
chkSL1.Checked := false;
chkSL2.Checked := false;
chkSL3.Checked := false;
chkSL0.Checked := lr.DrawBackground;
chkSL1.Checked := lr.AllowDuplicates;
chkSL2.Checked := lr.SplinedText;
chkSL3.Checked := lr.Flip;
//convert the OleFont to standard font
pfnt:=lr.Symbol[0].Font;//(Flyr.Symbol.Font);
dFnt:=pfnt as IFontDisp;
stdFont:=TFont.Create;
OleFontToFont(dFnt,stdFont);
txtSL.text := stdFont.Name;
txtSL.Font.Color := lr.Symbol[0].color;
cdlFont.Font:=stdFont;
stdFont.Free;
end;
procedure TFrmLayerSymbol.LoadNoOverlapLabels;
var
i : Integer;
scaleHeightUnit : Double;
strFN : String;
pfnt:IDispatch;
stdFont:TFont;
dFnt:IFontDisp;
lp:IMoLabelPlacer;
begin
lp := lyr.Renderer as IMoLabelPlacer;
colorMask := lp.MaskColor;
cboNOL.Clear;
for i := 0 to tDesc.FieldCount - 1 do
begin
strFN := tDesc.FieldName[i];
cboNOL.Items.Add(strFN);
if (lp.Field = strFN) then
cboNOL.ItemIndex := i;
end;
//convert the OleFont to standard font
pfnt:=IDispatch(lp.DefaultSymbol.Font);//(Flyr.Symbol.Font);
// pfnt:=lp.Symbol[0].Font;//(Flyr.Symbol.Font);
dFnt:=pfnt as IFontDisp;
stdFont:=TFont.Create;
OleFontToFont(dFnt,stdFont);
txtSL.text := stdFont.Name;
cdlFont.Font:=stdFont;
// FcolorText := stdFont.Color;
txtNOL.text := stdFont.Name;
txtNOL.Font.Color := colorText;
stdFont.Free;
optNOL0.Checked := lp.PlaceOn;
optNOL1.Checked := lp.PlaceAbove;
optNOL2.Checked := lp.PlaceBelow;
chkNOL0.Checked:=lp.DrawBackground;
chkNOL1.Checked:=lp.AllowDuplicates;
chkNOL2.Checked:=lp.MaskLabels;
if(lp.MaskLabels) then
picNOL.Font.Color := lp.MaskColor;
scaleHeightUnit := lyr.Extent.Width / 10000;
hsbNOL.Position := trunc(1000 - (lp.DefaultSymbol.Height / scaleHeightUnit));
end;
procedure TFrmLayerSymbol.LoadZRenderer;
var
j : Integer;
sym:IMoSymbol;
begin
zRend := lyr.Renderer as IMoZRenderer;
j := -1;
cboZRclasses.Clear;
cboZRclasses.text := inttostr(zRend.BreakCount + 1);
cboZRType.ItemIndex := zRend.ValueCalculation;
sym:= zRend.Symbol[0] as IMoSymbol;
picZRramp0.Color := sym.Color;
sym:=zRend.Symbol[zRend.BreakCount] as IMoSymbol;
picZRramp1.Color := sym.Color;
PopulateExistingZRlegend;
end;
//THE SIX PROCEDURES THAT FOLLOW, THAT BEGIN WITH THE WORD "APPLY..."
//ARE THOSE THAT RUN WHEN THE APPLY OR OK BUTTONS ARE CLICKED.
//THE CURRENT VALUES OF THE OPTION CONTROLS ARE READ, WRITTEN
//INTO A NEW RENDERER OBJECT. THEN THAT RENDERER OBJECT IS
//USED TO DRAW THE ACTIVE LAYER.
// ApplySingleSymbol()
// ApplyUniqueValues()
// ApplyClassBreaks()
// ApplyStandardLabels()
// ApplyNoOverlapLabels()
// ApplyZRenderer()
procedure TFrmLayerSymbol.ApplySingleSymbol;
var
sym : IMoSymbol;
fnt,fnt2:TFont;
symfnt:IDispatch;
//cChr:integer;
sz:Char;
begin
sym := lyr.Symbol;
lyr.Name := txtLayerName.text;
lyr.Renderer := NIL;
Case (lyr.shapeType) of
moShapeTypePoint:
begin
sym.color := picSSP0.Color;
sym.style := cboSSP0.ItemIndex;
if (hsbSSP.Position = 0) then
sym.Rotation := 0
else
//Clockwise instead of the default counter-clockwise
sym.Rotation := 360 - hsbSSP.Position;
sym.Size := StrToIntDef(txtSSP0.text,5);
if (sym.style = moTrueTypeMarker) then
begin
fnt:=TFont.Create;
fnt.Name := cboSSP1.text;
symfnt := IDispatch(FontToOleFont(fnt));
sym.Font:=IFontDisp(symfnt);
sym.CharacterIndex := cboSSP2.ItemIndex;
fnt.Free;
end;
end;
moShapeTypeMultipoint:
begin
sym.color := picSSP0.Color;
sym.style := cboSSP0.ItemIndex;
if (hsbSSP.Position = 0) then
sym.Rotation := 0
else
//Clockwise instead of the default counter-clockwise
sym.Rotation := 360 - hsbSSP.Position;
sym.Size := strtointdef(txtSSP0.text,5);
if (sym.style = moTrueTypeMarker) then
begin
fnt2:=TFont.Create;
fnt2.Name := cboSSP1.text;
symfnt := IDispatch(FontToOleFont(fnt2));
sym.Font:=IFontDisp(symfnt);
sz:=chr(strtoint(cboSSP2.text));
sym.CharacterIndex := ord(sz);
fnt2.Free;
end;
end;
moLine:
begin
sym.color := picSSP0.Color;
sym.style := cboSSP0.ItemIndex;
sym.Size := strtointdef(txtSSP0.text,1);
end;
moPolygon:
begin
sym.color := picSSP0.Color;
sym.OutlineColor := picSSP1.Color;
sym.style := cboSSP0.ItemIndex;
sym.Size := strtointdef(txtSSP0.text,1);
Case chkSSP.Checked of
true:
lyr.Symbol.Outline := True;
false:
begin
lyr.Symbol.OutlineColor := lyr.Symbol.color;
lyr.Symbol.Outline := False;
end;
end;
end;
end;
end;
procedure TFrmLayerSymbol.ApplyUniqueValues;
var
i : Integer;
symInt : Integer;
begin
if (lyr.shapeType = moShapeTypeMultipoint) then
symInt := 0
else
symInt := lyr.shapeType - 21;
vmr.SymbolType := symInt;
if (vmr.SymbolType = moFillSymbol) then
for i := 0 to vmr.ValueCount - 1 do
Case chkUV.Checked of
false:
begin
vmr.Symbol[i].Outline := False;
vmr.Symbol[i].OutlineColor := vmr.Symbol[i].color;
end;
true:
begin
vmr.Symbol[i].Outline := True;
vmr.Symbol[i].OutlineColor := moBlack;
end;
end;
lyr.Renderer := vmr;
end;
procedure TFrmLayerSymbol.ApplyClassBreaks;
var
i : Integer;
symInt : Integer;
begin
if (lyr.shapeType = moShapeTypeMultipoint) then
symInt := 0
else
symInt := lyr.shapeType - 21;
cbr.SymbolType := symInt;
if (cbr.SymbolType = moFillSymbol) then
for i := 0 To cbr.BreakCount do
Case chkCB.Checked of
false:
begin
cbr.Symbol[i].OutlineColor := cbr.Symbol[i].color;
cbr.Symbol[i].Outline := False;
end;
true:
begin
cbr.Symbol[i].OutlineColor := moBlack;
cbr.Symbol[i].Outline := True;
end;
end;
lyr.Renderer := cbr;
end;
procedure TFrmLayerSymbol.ApplyStandardLabels;
var
fnt :TFont;
lr:IMoLabelRenderer;
txtsym:IMoTextSymbol;
symfnt:IDispatch;
begin
fnt:=TFont.Create;
fnt:=cdlFont.Font;
lr := coLabelRenderer.Create;
lr.Field := cboSL0.text;
txtsym:=lr.Symbol[0];
with txtsym do
begin
if trim(cboSL1.text)='Left' then
HorizontalAlignment := moAlignLeft
else if trim(cboSL1.Text)='Center' then
HorizontalAlignment := moAlignCenter
else if trim(cboSL1.Text)= 'Right' then
HorizontalAlignment := moAlignRight;
if trim(cboSL2.text)='Top' then
VerticalAlignment := moAlignTop
else if trim(cboSL2.Text)='Center' then
VerticalAlignment := moAlignCenter
else if trim(cboSL2.Text)='Bottom' then
VerticalAlignment := moAlignBottom;
symfnt:=FontToOleFont(fnt);//(cdlFont.Font);
Font:=IFontDisp(symfnt);
Color:=cdlFont.Font.Color;
//Rotate clockwise instead of counter-clockwise
if (lblSL8.Caption = '0') then
Rotation := 0
else
Rotation := 360 - strtoint(lblSL8.Caption);
end;
with lr do
begin
XOffsetField := cboSL3.text;
YOffsetField := cboSL4.text;
DrawBackground := chkSL0.Checked;
AllowDuplicates := chkSL1.Checked;
SplinedText := chkSL2.Checked;
Flip := chkSL3.Checked;
end;
lyr.Renderer := lr;
end;
procedure TFrmLayerSymbol.ApplyNoOverlapLabels;
var
scaleHeightUnit : Double;
lp:IMoLabelPlacer;
symfnt:IDispatch;
begin
lp := coLabelPlacer.create;
lp.Field := cboNOL.text;
scaleHeightUnit := lyr.Extent.Width / 10000;
symfnt:=lp.DefaultSymbol.Font;
symfnt:=FontToOleFont(cdlFont.Font);
with lp.DefaultSymbol do
begin
Height := scaleHeightUnit * (1001 - hsbNOL.Position);
color := colorText;
Font := IFontDisp(symfnt);
end;
lp.PlaceAbove := optNOL1.Checked;
lp.PlaceBelow := optNOL2.Checked;
lp.PlaceOn := optNOL0.Checked;
lp.DrawBackground:=chkNOL0.Checked;
lp.AllowDuplicates:=chkSL1.Checked;
lp.MaskLabels:=chkNOL2.Checked;
if (lp.MaskLabels) then
lp.MaskColor:=picNOL.Color;
lyr.Renderer := lp;
end;
procedure TFrmLayerSymbol.ApplyZRenderer;
var
symInt : Integer;
begin
if (lyr.shapeType = moShapeTypeMultipoint) then
symInt := 0
else
symInt := lyr.shapeType - 21;
zRend.SymbolType := symInt;
lyr.Renderer := zRend;
end;
//THE NEXT SIX PROCEDURES THAT START WITH THE WORD "POPULATE..."
//ARE THOSE THAT RUN WHEN ONE OF THE "RESET LEGEND" BUTTONS
//ARE PRESSED. THESE PROCEDURES CALCULATE AND LOAD A LEGEND
//PREVIEW ON THE LAYERSYMBOL FORM THAT THE USER CAN EXAMINE
//BEFORE APPLYING TO THE MAP.
// PopulateNewUVLegend, PopulateExistingUVLegend (unique values)
// PopulateNewCBLegend, PopulateExistingCBLegend (class breaks)
// PopulateNewZRLegend, PopulateExistingZRLegend (elevation Z values)
procedure TFrmLayerSymbol.PopulateNewUVlegend(rendField : String);
var
strsUniqueValues:IMoStrings;
fld:IMoField;
i,yn:Integer;
picUV:TStaticText;
lblUV:TLabel;
// vmr:IMoValueMapRenderer;
begin
strsUniqueValues:=coStrings.create;
fld := flds.item(rendField);
if (fld=NIL) then
exit;
Screen.Cursor := moHourglass;
recs.MoveFirst;
while not(recs.EOF) do
begin
strsUniqueValues.Add(fld.Value);
recs.MoveNext;
end;
Screen.Cursor := moDefault;
if (strsUniqueValues.count > 100) then
begin
yn := Application.MessageBox('Number of unique values is greater than 100. Would you like to continue?',
'Unique values',MB_YESNO);
if (yn = IDNO) then
exit;
end;
fraUVInner.Visible := false;
if (picUVs.count > 1) then
for i := (picUVs.count - 1) downto 1 do
begin
picUV:=TStaticText(picUVs[i]);
lblUV:=TLabel(lblUVs[i]);
fraUVInner.RemoveControl(picUV);
fraUVInner.RemoveControl(lblUV);
PicUVs.Remove(picUV);
lblUVs.Remove(lblUV);
end;
fraUVInner.Visible := true;
picUVs.Capacity := picUVs.Count;
lblUVs.Capacity := lblUVs.Count;
vmr := coValueMapRenderer.Create;
vmr.Field := rendField;
vmr.ValueCount := strsUniqueValues.count;
for i := 0 to strsUniqueValues.count - 1 do
vmr.Value[i] := strsUniqueValues.Item(i);
fraUVouter.Caption := UpperCase(lyr.Name) + ' - ' + cboUV.text;
TStaticText(picUVs[0]).Visible := True;
TLabel(lblUVS[0]).Visible := True;
TStaticText(picUVs[0]).Color := vmr.Symbol[0].color;
TLabel(lblUVS[0]).Caption := vmr.Value[0];
fraUVInner.Visible := false;
for i := 1 to vmr.ValueCount - 1 do
begin
picUV:=TStaticText.Create(fraUVinner);
with picUV do
begin
Parent:=fraUVInner;
Left := TStaticText(picUVs[0]).Left;
Width := TStaticText(picUVs[0]).Width;
Height := TStaticText(picUVs[0]).Height;
Top := TStaticText(picUVs[0]).Top + 12*i;
Color := vmr.Symbol[i].color;
Visible := True;
end;
picUVs.Add(picUV);
lblUV:=TLabel.Create(fraUVInner);
with lblUV do
begin
Parent:=fraUVInner;
Left := TLabel(lblUVs[0]).Left;
Width := TLabel(lblUVs[0]).Width;
Height := TLabel(lblUVs[0]).Height;
Top := TLabel(lblUVs[0]).Top + 12*i;
Caption := vmr.Value[i];
Visible := True
end;
lblUVs.Add(lblUV);
end;
fraUVInner.Visible := true;
//fraUVinner.Height := (vmr.ValueCount * 12) + 17;
end;
procedure TFrmLayerSymbol.PopulateExistingUVlegend;
var
// recs : IMoRecordset;
// fld : IMoField;
i : Integer;
picUV:TStaticText;
lblUV:TLabel;
// vmr:IMoValueMapRenderer;
begin
if not(justOpened) then
exit;
vmr := lyr.Renderer as IMoValueMapRenderer;
fraUVInner.Visible := false;
if (picUVs.count > 1) then
for i := (picUVs.count - 1) downto 1 do
begin
picUV:=TStaticText(picUVs[i]);
lblUV:=TLabel(lblUVs[i]);
fraUVInner.RemoveControl(picUV);
fraUVInner.RemoveControl(lblUV);
PicUVs.Remove(picUV);
lblUVs.Remove(lblUV);
//picUV.Free;
//lblUV.Free;
end;
picUVs.Capacity := picUVs.Count;
lblUVs.Capacity := lblUVs.Count;
fraUVInner.Visible := true;
fraUVouter.Caption := UpperCase(lyr.Name) + ' - ' + vmr.Field;
TStaticText(picUVs[0]).Visible := True;
TLabel(lblUVS[0]).Visible := True;
TStaticText(picUVs[0]).Color := vmr.Symbol[0].color;
TLabel(lblUVS[0]).Caption := vmr.Value[0];
fraUVInner.Visible := false;
for i := 1 to vmr.ValueCount - 1 do
begin
picUV:=TStaticText.Create(fraUVinner);
with picUV do
begin
Parent:=fraUVinner;
Left := TStaticText(picUVs[0]).Left;
Width := TStaticText(picUVs[0]).Width;
Height := TStaticText(picUVs[0]).Height;
Top := TStaticText(picUVs[0]).Top + 12*i;
Color := vmr.Symbol[i].color;
Visible := True;
end;
picUVs.Add(picUV);
lblUV:=TLabel.Create(fraUVinner);
with lblUV do
begin
Parent:=fraUVinner;
Left := TLabel(lblUVs[0]).Left;
Width := TLabel(lblUVs[0]).Width;
Height := TLabel(lblUVs[0]).Height;
Top := TLabel(lblUVs[0]).Top + 12*i;
Caption := vmr.Value[i];
Visible := true;
end;
lblUVs.Add(lblUV);
end;
fraUVInner.Visible := true;
justOpened := False;
end;
procedure TFrmLayerSymbol.PopulateNewCBlegend(rendField : String);
var
stats : IMoStatistics;
range : Double;
i, numClasses, numBreaks : Integer;
picCB:TStaticText;
lblCB:TLabel;
begin
if (Trim(cboCB0.text) = '') then
cboCB0.ItemIndex := 0;
stats := recs.CalculateStatistics(cboCB0.text);
numClasses := strtoint(cboCB1.text);
numBreaks := numClasses - 1;
fraCBInner.Visible := false;
if (picCBlegends.count > 1) then
begin
for i := (picCBlegends.count - 1) downto 1 do
begin
picCB:=TStaticText(picCBLegends[i]);
lblCB:=TLabel(lblCBLegends[i]);
fraCBInner.RemoveControl(picCB);
fraCBInner.RemoveControl(lblCB);
picCBLegends.Remove(picCB);
lblCBLegends.Remove(lblCB);
end;
picCBLegends.Capacity := picCBLegends.Count;
lblCBLegends.Capacity := lblCBLegends.Count;
end;
fraCBInner.Visible := true;
cbr := coClassBreaksRenderer.Create;
cbr.Field := cboCB0.text;
cbr.BreakCount := numBreaks;
range := stats.Max - stats.Min;
for i := 0 To numBreaks - 1 do
cbr.Break[i] := stats.Min + ((range / numClasses) * (i + 1));
cbr.RampColors(picCBramp0.Color, picCBramp1.Color);
fraCBOuter.Caption := UpperCase(lyr.Name) + ' - ' + cboCB0.text;
TStaticText(picCBlegends[0]).Visible := True;
TLabel(lblCBlegends[0]).Visible := True;
TStaticText(picCBlegends[0]).Color := cbr.Symbol[0].color;
TLabel(lblCBlegends[0]).Caption := 'Less than ' + format('%8.2f',[cbr.Break[0]] );
fraCBInner.Visible := false;
for i := 1 to cbr.BreakCount do
begin
picCB:=TStaticText.Create(fraCBInner);
with picCB do
begin
Parent:=fraCBInner;
Left := TStaticText(picCBlegends[0]).Left;
Width := TStaticText(picCBlegends[0]).Width;
Height := TStaticText(picCBlegends[0]).Height;
Top := TStaticText(picCBlegends[0]).Top + 12*i;
Color := cbr.Symbol[i].color;
Visible := True;
end;
picCBLegends.Add(picCB);
lblCB:=TLabel.Create(fraCBInner);
with lblCB do
begin
Parent:=fraCBInner;
Left := TLabel(lblCBlegends[0]).Left;
Width := TLabel(lblCBlegends[0]).Width;
Height := TLabel(lblCBlegends[0]).Height;
Top := TLabel(lblCBlegends[0]).Top + 12*i;
Visible := True;
if (i=cbr.BreakCount) then
Caption := '>= ' + format('%8.2f',[cbr.Break[cbr.BreakCount - 1]])
else
Caption := format('%8.2f',[cbr.Break[i - 1]]) + ' - ' + format('%8.2f',[cbr.Break[i]]);
end;
lblCBLegends.Add(lblCB);
end;
fraCBInner.Visible := true;
end;
procedure TFrmLayerSymbol.PopulateExistingCBlegend;
var
stats : IMoStatistics;
i, numBreaks : Integer;
// cbr:IMoClassBreaksRenderer;
picCB:TStaticText;
lblCB:TLabel;
begin
if not(justOpened) then
exit;
cbr:=lyr.Renderer as IMoClassBreaksRenderer;
stats := recs.CalculateStatistics(cbr.Field);
numBreaks := cbr.BreakCount;
fraCBInner.Visible := false;
if (picCBlegends.count > 1) then
for i := (picCBlegends.count - 1) downto 1 do
begin
picCB:=TStaticText(picCBLegends[i]);
lblCB:=TLabel(lblCBLegends[i]);
fraCBInner.RemoveControl(picCB);
fraCBInner.RemoveControl(lblCB);
picCBLegends.Remove(picCB);
lblCBLegends.Remove(lblCB);
//picCB.Free;
//lblCB.Free;
end;
picCBLegends.Capacity := picCBLegends.Count;
lblCBLegends.Capacity := lblCBLegends.Count;
fraCBInner.Visible := true;
fraCBOuter.Caption := UpperCase(lyr.Name) + ' - ' + cboCB0.text;
TStaticText(picCBlegends[0]).Visible := True;
TLabel(lblCBlegends[0]).Visible := True;
TStaticText(picCBlegends[0]).Color := cbr.Symbol[0].color;
TLabel(lblCBlegends[0]).Caption := 'Less than ' + format('%8.2f',[cbr.Break[0]]);
fraCBInner.Visible := false;
for i := 1 To cbr.BreakCount do
begin
picCB:=TStaticText.Create(fraCBInner);
with picCB do
begin
Parent:=fraCBInner;
Left := TStaticText(picCBlegends[0]).Left;
Width := TStaticText(picCBlegends[0]).Width;
Height := TStaticText(picCBlegends[0]).Height;
Top := TStaticText(picCBlegends[0]).Top + 12*i;
Color := cbr.Symbol[i].color;
Visible := True;
end;
picCBLegends.Add(picCB);
lblCB:=TLabel.Create(fraCBInner);
with lblCB do
begin
Parent:=fraCBInner;
Left := TLabel(lblCBlegends[0]).Left;
Width := TLabel(lblCBlegends[0]).Width;
Height := TLabel(lblCBlegends[0]).Height;
Top := TLabel(lblCBlegends[0]).Top + 12*i;
Visible := True;
if (i=cbr.BreakCount) then
Caption := '>= ' + format('%8.2f',[stats.Max])
else
Caption := format('%8.2f',[cbr.Break[i - 1]]) + ' - ' + format('%8.2f',[cbr.Break[i]]);
end;
lblCBLegends.Add(lblCB);
end;
fraCBInner.Visible := true;
justOpened := False;
end;
procedure TFrmLayerSymbol.PopulateNewZRLegend;
var
n : Integer;
range : Double;
MinZ,MaxZ : Double;
picZR:TStaticText;
lblZR:TLabel;
zRend:IMoZRenderer;
begin
MinZ := lyr.Extent.Floor;
MaxZ := lyr.Extent.Ceiling;
MaxZ := 1400;
range := MaxZ - MinZ;
fraZR.Visible := false;
//clear existing legend
if (picZRlegends.count > 1) then
for n := (picZRlegends.count - 1) downto 1 do
begin
picZR:=TStaticText(picZRLegends[n]);
lblZR:=TLabel(lblZRLegends[n]);
fraZR.RemoveControl(picZR);
fraZR.RemoveControl(lblZR);
picZRLegends.Remove(picZR);
lblZRLegends.Remove(lblZR);
//picZR.Free;
//lblZR.Free;
end;
fraZR.Visible := true;
picZRLegends.Capacity := picZRLegends.Count;
lblZRLegends.Capacity := lblZRLegends.Count;
//set new breakcount
zRend := coZRenderer.Create;
zRend.BreakCount := cboZRclasses.ItemIndex - 1;
//Set the breaks using simple equal interval ranges...
for n := 1 To zRend.BreakCount do
zRend.Break[n - 1] := MinZ + ((range / zRend.BreakCount + 1) * (n));
//Build symbol array by ramping start and end colors
zRend.RampColors (picZRramp0.Color, picZRramp1.Color);
//handle the base items in the object arrays
TStaticText(picZRlegends[0]).Color := picZRramp0.Color;
TLabel(lblZRlegends[0]).Caption := 'Less Than ' + format('%8.2f',[zRend.Break[0]]);
TStaticText(picZRlegends[0]).Visible := True;
TLabel(lblZRlegends[0]).Visible := True;
fraZR.Visible := false;
for n := 1 to zRend.BreakCount do
begin
//Set up the color boxes
picZR:=TStaticText.Create(fraZR);
with picZR do
begin
Parent:=fraZR;
Height:=TStaticText(picZRLegends[0]).Height;
Left:=TStaticText(picZRLegends[0]).Left;
Width:=TStaticText(picZRLegends[0]).Width;
Top := TStaticText(picZRlegends[0]).Top + 12*n;
Color := IMoSymbol(zRend.Symbol[n]).color;
Visible := True;
end;
picZRLegends.Add(picZR);
//Set up the labels
lblZR:=TLabel.Create(fraZR);
with lblZR do
begin
Parent:=fraZR;
Left:=TLabel(lblZRLegends[0]).Left;
Height:=TLabel(lblZRLegends[0]).Height;
Width:=TLabel(lblZRLegends[0]).Width;
Top := TLabel(lblZRLegends[0]).Top + 12*n;
Visible := True;
if (n=zRend.BreakCount) then
Caption := 'Greater Than ' + format('#0.00',[zRend.Break[n - 1]])
else
Caption := format('%8.2f',[zRend.Break[n - 1]]) + ' - ' + format('%8.2f',[zRend.Break[n]]);
end;
lblZRLegends.Add(lblZR);
end;
fraZR.Visible := true;
end;
procedure TFrmLayerSymbol.PopulateExistingZRlegend;
var
stats : IMoStatistics;
i : Integer;
zRend:IMoZRenderer;
picZR:TStaticText;
lblZR:TStaticText;
begin
if not(justOpened) then
exit;
zRend := lyr.Renderer as IMoZRenderer;
fraZR.Visible := false;
if (picZRlegends.count > 1) then
for i := (picZRlegends.count - 1) downto 1 do
begin
picZR:=TStaticText(picZRLegends[i]);
lblZR:=TStaticText(lblZRLegends[i]);
fraZR.RemoveControl(picZR);
fraZR.RemoveControl(picZR);
picZRLegends.Remove(picZR);
lblZRLegends.Remove(lblZR);
//picZR.Free;
//lblZR.Free;
end;
fraZR.Visible := true;
picZRLegends.Capacity := picZRLegends.Count;
lblZRLegends.Capacity := lblZRLegends.Count;
TStaticText(picZRLegends[0]).Visible := True;
TLabel(lblZRlegends[0]).Visible := True;
TStaticText(picZRLegends[0]).Color := IMoSymbol(zRend.Symbol[0]).color;
TLabel(lblZRlegends[0]).Caption := 'Less than ' + format('%8.2f',[zRend.Break[0]]);
fraZR.Visible := false;
for i := 1 To zRend.BreakCount do
begin
picZR:=TStaticText.Create(fraZR);
with picZR do
begin
Parent := fraZR;
Left := TStaticText(picZRlegends[0]).Left;
Width := TStaticText(picZRlegends[0]).Width;
Height := TStaticText(picZRlegends[0]).Height;
Top := TStaticText(picZRlegends[0]).Top + 12*i;
Color := IMoSymbol(zRend.Symbol[i]).color;
Visible := True;
end;
picZRLegends.Add(picZR);
lblZR:=TStaticText.Create(fraZR);
with lblZR do
begin
Parent := fraZR;
Left := TStaticText(lblZRlegends[0]).Left;
Width := TStaticText(lblZRlegends[0]).Width;
Height := TStaticText(lblZRlegends[0]).Height;
Top := TStaticText(lblZRlegends[0]).Top + 12*i;
Visible := True;
if (i=zRend.BreakCount) then
Caption := '>= ' + format('#0.00',[stats.Max])
else
Caption := format('%8.2f',[zRend.Break[i - 1]]) + ' - ' + format('%8.2f',[zRend.Break[i]]);
end;
lblZRLegends.Add(lblZR);
end;
fraZR.Visible := true;
justOpened := False;
end;
procedure TFrmLayerSymbol.picNOLClick(Sender: TObject);
begin
//User changes the MaskColor of the LabelPlacer
if (colorMask <> moWhite) then
cdlColor.color := colorMask;
if(cdlColor.Execute) then
begin
picNOL.Color := cdlColor.color;
colorMask := cdlColor.color;
end;
//Turn on the MaskLabels check box
chkNOL2.Checked := true;
end;
procedure TFrmLayerSymbol.picSSP0Click(Sender: TObject);
begin
if (colorMask <> moWhite) then
cdlColor.color := colorMask;
if(cdlColor.Execute) then
begin
picSSP0.Color := cdlColor.color;
colorMask := cdlColor.color;
end;
end;
procedure TFrmLayerSymbol.picCBRamp0Click(Sender: TObject);
begin
if (cdlColor.Execute) then
picCBramp0.Color:= cdlColor.Color;
end;
end.