📄 code1.txt
字号:
if SbPan.Down then
//地图平移
begin
MainMap.Pan;
MainMap.MousePointer:=MoPanning;
exit;
end;
{***************************************************************************}
end;
end;
procedure TMainFrm.BadvanceQueryClick(Sender: TObject);
begin
if MainMap.Layers.Count > 0 then
QueryFrm.ShowModal
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.FormActivate(Sender: TObject);
begin
CurrentLayer:=comaplayer.Create;
end;
procedure TMainFrm.MainMapAfterLayerDraw(Sender: TObject; index: Smallint;
canceled: WordBool; hDC: Cardinal);
var
MySymbol:imoSymbol;
v : Variant;
begin
MySymbol:=CoSymbol.Create;
MySymbol.Color:=ClYellow;
if Assigned(FindRecord)then
MainMap.DrawShape(FindRecord,MySymbol);
MainMap.Refresh;
{////////////////////////////////////////}
if index =0 then
// after drawing the first layer, refresh the locater map
LocalMap.TrackingLayer.Refresh(True,v);
//end;
end;
procedure TMainFrm.RbAtrCheckClick(Sender: TObject);
begin
if RbAtrCheck.Checked then
begin
EdtName.Enabled:=true;
BbChaxun.Enabled :=true;
BadvanceQuery.Enabled:=true;
EdtName.SetFocus;
end;
end;
procedure TMainFrm.RbSrCheckClick(Sender: TObject);
begin
if RbSrCheck.Checked then
begin
EdtName.Enabled:=false;
BbChaxun.Enabled :=false;
BadvanceQuery.Enabled:=false;
end;
end;
procedure TMainFrm.BbChaxunClick(Sender: TObject);
var
i:integer;
ThisRecord:ImoRecordSet;
ThisTable:ImoTableDesc;
ThisPoint:imoPoint;
begin
if MainMap.Layers.Count > 0 then
begin
CurrentLayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(0));
//按地名模糊查询
FindRecord:= CurrentLayer.SearchExpression('Name like'+' '+chr(39)+EdtName.Text+'%'+chr(39));
//MainFrm.MainMap.Refresh;
//提取属性值
ThisTable:=coTableDesc.Create;
Currentlayer:=ImoMaplayer(MainMap.Layers.Item(0));
//ThisPoint:=CoPoint.Create;
//ThisPoint:=MainMap.ToMapPoint(X,Y);
//ThisRecord:=CurrentLayer.SearchShape(ThisPoint,12,'');
ThisTable:=MainFrm.FindRecord.TableDesc;
//MainFrm.FindRecord.MoveFirst ;
//if not FindRecord.EOF then
//begin
StringGrid1.Cells[0,0] :=' 字段 ';
StringGrid1.Cells[1,0] :=' 值 ';
StringGrid1.RowCount:=ThisTable.FieldCount-1;
for i := 0 to ThisTable.FieldCount-1 do
begin
StringGrid1.Cells[0,i+1] := FindRecord.fields.Item(ThisTable.FieldName[i]).Name ;
StringGrid1.Cells[1,i+1] := FindRecord.fields.Item(ThisTable.FieldName[i]).ValueAsString;
end;
// MainFrm.FindRecord.MoveNext;
//end;
StringGrid1.Visible:= True;
MenuVLMap.Checked:=False;
MainFrm.MainMap.FlashShape(FindRecord.Fields.Item('Shape').Value,10);
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.PageControl1Change(Sender: TObject);
var
i:integer;
begin
CbbLayers.clear;
CbbFields.Clear;
for i:=0 to MainFrm.MainMap.Layers.Count-1 do
begin
Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(i));
CbbLayers.Items.Add(Currentlayer.Name);
end;
CbbLayers.Itemindex:=0;
CbbLayers.OnChange(sender);
end;
procedure TMainFrm.CbbLayersChange(Sender: TObject);
var
MyTableDesc:imoTableDesc;
i:integer;
begin
if MainFrm.MainMap.Layers.Count>0 then
begin
MyTableDesc:=CoTableDesc.Create;
Currentlayer:=ImoMaplayer(MainFrm.MainMap.Layers.Item(CbbLayers.Text));
MyTableDesc:=Currentlayer.Records.TableDesc;
CbbFields.Clear;
for i:=0 to MyTableDesc.FieldCount-1 do
begin
CbbFields.Items.Add(MyTableDesc.FieldName[i]);
end;
CbbFields.ItemIndex:=0;
end
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.PanelStaColClick(Sender: TObject);
begin
if ColorDialog1.Execute then
PanelStaCol.Color:= ColorDialog1.Color;
end;
procedure TMainFrm.PanelFinColClick(Sender: TObject);
begin
if ColorDialog1.Execute then
PanelFinCol.Color:= ColorDialog1.Color;
end;
procedure TMainFrm.BtSureClick(Sender: TObject);
var
MyRecord:imoRecordSet;
MyBreaksCount:integer;
MyRenderer:imoClassBreaksRenderer;
i,j:integer;
begin
CurrentLayer:=ImoMaplayer(MainMap.Layers.Item(CbbLayers.Text));
Myrenderer:=coClassBreaksRenderer.Create;
MyRecord:=CurrentLayer.SearchExpression(CbbFields.Text+ '>-1 Order by '+ CbbFields.Text);
Myrenderer.Field:=CbbFields.Text;
MyBreaksCount:=strToInt(EdtBreaksCount.Text);
Myrenderer.BreakCount:=MyBreaksCount;
For i:=1 to MyBreaksCount-1 do
begin
For j:=0 to Round(MyRecord.Count/MyBreaksCount)do
Myrecord.moveNext;
MyRenderer.Break[i]:=MyRecord.fields.item(CbbFields.Text).value;
//设置分位点并赋值
end;
Myrenderer.RampColors(PanelStaCol.Color,PanelFinCol.Color);
Currentlayer.Renderer:=MyRenderer;
MainMap.refresh;
end;
//分位数法制作专题图
procedure TMainFrm.LocalMapAfterTrackingLayerDraw(Sender: TObject;
hDC: Cardinal);
var
sym : IMoSymbol;
begin
sym := CoSymbol.Create;
sym.OutlineColor := moRed;
sym.Style := moTransparentFill;
LocalMap.DrawShape(MainMap.Extent,sym);
end;
procedure TMainFrm.Exit1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMainFrm.MenuVLMapClick(Sender: TObject);
begin
if sender is TMenuItem then
//控制显示 流览,地图工具栏,状态栏
case (sender as TMenuItem).Tag of
1:
begin
LocalMap.Visible:=MainFrm.MenuVLMap.Checked;
if not MainFrm.MenuVLMap.Checked then StringGrid1.Visible:= true
else
StringGrid1.Visible:=False;
end;
2:
ToolBar1.Visible:=MainFrm.MuneVTool.Checked ;
3:
StatusBar1.Visible:=MainFrm.MenuVSBar.Checked ;
end;
end;
procedure TMainFrm.MnASetClick(Sender: TObject);
begin
if MainFrm.MainMap.Layers.Count>0 then
PointSetFrm.ShowModal
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.MnAttrbuteClick(Sender: TObject);
begin
if MainFrm.MainMap.Layers.Count>0 then
ViewAttrFrm.Show
else
Application.MessageBox('请添加图层', '提示', MB_OK);
end;
procedure TMainFrm.LocalMapMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
MyPoint:ImoPoint;
begin
MyPoint:=CoPoint.Create;
MyPoint:=LocalMap.ToMapPoint(X,Y);
MainMap.CenterAt(MyPoint.X,MyPoint.Y);
if MainMap.Extent.IsPointIn(MyPoint) then
begin
MyDragFeedback.DragStart(MainMap.Extent,LocalMap,X,Y);
end;
end;
procedure TMainFrm.LocalMapMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if not (MyDragFeedback =NIL) then
MyDragfeedback.DragMove(x,y);
end;
procedure TMainFrm.LocalMapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not (Mydragfeedback = NIL) then
begin
LocalMap.Refresh;
MainMap.extent := IMoRectangle(MyDragFeedback.DragFinish(x,y));
end;
end;
procedure TMainFrm.MnLableClick(Sender: TObject);
begin
LabelFrm.ShowModal;
end;
procedure TMainFrm.N2Click(Sender: TObject);
begin
RendererFrm.ShowModal;
end;
procedure TMainFrm.PMnZoomInClick(Sender: TObject);
begin
if sender is TPopupMenu then
begin
SbZoomIn.Click;
case(sender as TPopupMenu).Tag of
1:
SbZoomIn.Down:=true ;
2:
SbZoomOut.Down:=true ;
end;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -