code.txt

校园GIS系统——介绍校园个部门

  Welcomefrm := TWelcomefrm.Create(Application); {Create创建闪现窗口对象}
  Welcomefrm.Show;
  Welcomefrm.Update;
  Welcomefrm.Hide;
  Welcomefrm.Free;

//


private
    { Private declarations }
  public
      { Public declarations }
    recs1, recs2: IMoRecordset;
    currentid: integer;
    kaiguan: Integer;
  end;
var
  frmmain: Tfrmmain;
  g_SelectedBounds: IMoRectangle;
  g_SearchBounds: IMoRectangle;
  gCurPoint: integer;
  g_layer: IMoMapLayer;
  gs: IMoGeoDataset;
  lyrs: IMOLayers;
  pt: IMoPoint;
  DragFeedbk: TDragfeedback;
const
  ScreenHeight: Integer = 800;
  ScreenWidth: Integer = 600;
   //ScreenHeight:Integer=1024;
   //ScreenWidth:Integer=768;
implementation
uses coordinate, about, commonunit, mapmanage, mapinformationlook,
  lookresult, specialmap, maplabel, drawmap;

procedure Tfrmmain.mapadd(map: Tmap; str: string);
var
  g_layer: IMoMaplayer;
begin
  g_layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
  g_layer.GeoDataset := gs;
  lyrs := map.Layers;
  lyrs.Add(g_layer);
  map.Refresh;

//  map.OutputMap(image1.handle);
  frmcommon.picturemanagecolorlblcolor(0);
end;
{$R *.DFM}

procedure Tfrmmain.mainmapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  lyr: IMoMapLayer;
  rectangle: IMoRectangle;
begin
  if mainmap.Layers.Count <> 0 then
  begin
    if Button = mbLeft then
    begin
     // frmcoordinate.mocoordinate.Lines.Clear();
      pt := IMoPoint(CreateOleObject('MapObjects2.Point'));
      pt := mainmap.ToMapPoint(x, y);
      lyrs := mainmap.layers;
      lyr := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
      lyr := IMoMapLayer(lyrs.item(0));
      if currentid = 1 then
        mainmap.Extent := mainmap.TrackRectangle
      else if currentid = 2 then
      begin
        rectangle := mainmap.Extent;//TrackRectangle
        rectangle.ScaleRectangle(variant(1.5)); // zoom out mainmap.TrackRectangle.width/mainmap.width
        mainmap.Extent := rectangle;
      end
      else if currentid = 3 then
        mainmap.Pan
      else if currentid = 4 then /////////////查找所属块
      begin
        recs1 := lyr.SearchShape(pt, moPointInPolygon, '');
        frmcommon.qudian(recs1);
      end
     // else if currentid = 0 then
    //    Application.MessageBox('没有选择操作,请选择你想要进行的选项', '提示', MB_OK);
    end;
  end
  else
    Application.MessageBox('请增加图层', '提示', MB_OK);
end;

procedure Tfrmmain.fileopenClick(Sender: TObject);
begin
  frmpicturemanage.visible := true;
end;


procedure Tfrmmain.mainwholemapbtClick(Sender: TObject);
begin
  mainmap.Extent := mainmap.FullExtent;
end;

procedure Tfrmmain.zoominClick(Sender: TObject);
begin
  currentid := 1;
  mainmap.Cursor := crDefault;
end;

procedure Tfrmmain.zoomoutClick(Sender: TObject);
begin
  currentid := 2;
  mainmap.Cursor := crDefault;
end;

procedure Tfrmmain.mainmenupictureoperatemoveClick(Sender: TObject);
begin
  currentid := 3;
  mainmap.Cursor := crHandPoint;
end;

procedure Tfrmmain.pictureviewClick(Sender: TObject);
begin
  mainmap.Extent := mainmap.FullExtent;
end;

procedure Tfrmmain.mainzoominbtClick(Sender: TObject);
begin
  currentid := 1;
  mainmap.Cursor := crDefault;
end;

procedure Tfrmmain.mainzoomoutbtClick(Sender: TObject);
begin
  currentid := 2;
  mainmap.Cursor := crDefault;
end;

procedure Tfrmmain.mainmoveBtClick(Sender: TObject);
begin
  currentid := 3;
  mainmap.Cursor := crHandPoint;
end;

procedure Tfrmmain.choiceClick(Sender: TObject);
begin
  currentid := 4;
  mainmap.Cursor := crDefault;
end;

procedure Tfrmmain.FormActivate(Sender: TObject);
begin
  count1 := 0;
  maxx := 0;
  maxy := 0;
  maxz := 0;
end;

procedure Tfrmmain.FormResize(Sender: TObject);
begin
{  mainmap.Left := 161;
  mainmap.Width := frmmain.Width - 170;
  panel2.Height := frmmain.Height - 82;
  mainmap.Height := frmmain.Height - 82;
  Splitter1.Height := frmmain.Height - 82;
  fullmap.top := frmmainstatusbar.Top + 89;}
end;

procedure Tfrmmain.mapmanagebtClick(Sender: TObject);
begin
  frmpicturemanage.visible := true;
end;

procedure Tfrmmain.aboutGISClick(Sender: TObject);
begin
  frmhelp.Visible := True;
end;

procedure Tfrmmain.mainmenuqueryinfoClick(Sender: TObject);
begin
  if frmmain.mainmap.Layers.Count > 0 then
    frmquery.Visible := True
  else
    Application.MessageBox('请添加图层', '提示', MB_OK);
end;

procedure Tfrmmain.lookupspbtClick(Sender: TObject);
begin
  frmquery.Visible := True;
end;

procedure Tfrmmain.maplookbtClick(Sender: TObject);
begin
  if frmmain.mainmap.Layers.Count > 0 then
    frmquery.Visible := True
  else
    Application.MessageBox('请添加图层', '提示', MB_OK);
end;

procedure Tfrmmain.mainmapAfterTrackingLayerDraw(Sender: TObject;
  hDC: Cardinal);
begin
  if not ((varisempty(g_searchBounds)) and (varisempty(g_selectedBounds)))
    then exit;
  frmcommon.DrawRecordset(mainmap, recs1, $FF00FF, 0);
end;

procedure Tfrmmain.mainmapMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  mappoint: IMoPoint;
begin
  if mainmap.Layers.Count <> 0 then
  begin
    mappoint := IMoPoint(CreateOleObject('MapObjects2.Point'));
    mappoint := mainmap.ToMapPoint(x, y);
    frmmainstatusbar.Panels.Items[1].Text := 'X: ' + FloatToStr(mappoint.x + 120)
      + '   Y: ' + FloatToStr(mappoint.y - 20);
  end;
end;

procedure Tfrmmain.Timer1Timer(Sender: TObject);
begin
  frmmainstatusbar.Panels.Items[3].Text := TimeToStr(Time);
 //   flashWindow(handle,True);
end;

procedure Tfrmmain.Button1Click(Sender: TObject);
begin
  frmmoreinformation.Visible := True;
end;

procedure Tfrmmain.SpeedButton1Click(Sender: TObject);
begin
  frmquery.Visible := True;
end;

procedure Tfrmmain.SpeedButton2Click(Sender: TObject);
var
  rec: IMoRecordset;
  strs: IMoStrings;
  //i: Integer;
 // looklayerr: IMoMapLayer;
  looklayers: IMoLayers;
begin
  //frmrender.Visible := True;
  {looklayers:=frmrender.Map1.Layers ;
   looklayerr := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
   looklayerr := IMoMaplayer(looklayers.Item(0));
  rec:=IMoRecordset(looklayerr.Records);
  while not rec.EOF do
  begin
  strs.Add(rec.fields.item('STATE_NAME').value);
  rec.MoveNext ;
  end;
  for i:=1 to strs.Count do
   frmrender.listbox.Items.Add(strs[i].value);
   }
end;
{Procedure Tfrmmain.CreateParams(Var Params:TCreateParams);
begin
inherited CreateParams(Params);
params.ExStyle:=params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure Tfrmmain.FormCreate(Sender: TObject);
begin                  inherited;
Canvas.Brush.Style:=bsClear;
end;
 }

procedure Tfrmmain.fileCADopenClick(Sender: TObject);
var
  FileType:integer;
  LayerType:string;
  dc: ImoDataConnection;
  gds: ImoGeoDataSet;
  Layer: ImoMapLayer;
  name: string;
  Line: ImoLine;
begin
  OpenDialog1.Filter := 'CAD(*.dwg)|*.dwg|CAD(*.dxf)|*.dxf';
  if OpenDialog1.Execute then
  begin

  case FileType of
    3:
      LayerType:= '[CADPoint]';
    4:
      LayerType := '[CADLine]';
    5:
      LayerType := '[CADArea]';
    6:
      LayerType := '[CADText]';
  end;

    dc := ImoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
    Layer := ImoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
    name := opendialog1.filename;
    dc.Database := '[CADText]' + GetCurrentDir;
    if not dc.connect then exit;
    while pos('\', name) > 0 do
    begin
      delete(name, 1, 1);
    end;
    gds := dc.FindGeoDataset(name);
    if VarIsEmpty(gds) then exit; //  ShowMessage('');
    Layer.Symbol.Color := MoGreen;
    layer.GeoDataset := gds;
    Line := ImoLine(mainmap.Layers);
    lyrs := mainmap.Layers;
    lyrs.Add(layer);
    while pos('.', name) > 0 do
      delete(name, pos('.', name), 4);
    frmmainstatusbar.Panels.Items[2].Text := '当前层: ' + name;

  end;
end;

procedure Tfrmmain.SpecialpictureBtClick(Sender: TObject);
begin
  if mainmap.Layers.Count > 0 then
    frmspecialmap.show
  else
    Application.MessageBox('没有图层，请先选择图层管理，添加图层', '提示', MB_OK);
end;

procedure Tfrmmain.maplabelBtClick(Sender: TObject);
begin
  if mainmap.Layers.Count > 0 then
    frmmaplabel.Show
  else
    Application.MessageBox('没有图层，请先选择图层管理，添加图层', '提示', MB_OK);
end;


procedure Tfrmmain.toolbarmenuClick(Sender: TObject);
begin
  toolbarmenu.Checked := not toolbarmenu.Checked;
  frmmainToolBar.Visible := toolbarmenu.Checked;
end;

procedure Tfrmmain.StatusbarmenuClick(Sender: TObject);
begin
  Statusbarmenu.Checked := not Statusbarmenu.Checked;
  frmmainstatusbar.Visible := Statusbarmenu.Checked;
end;

procedure Tfrmmain.fullpicturemenuClick(Sender: TObject);
begin
  fullpicturemenu.Checked := not fullpicturemenu.Checked;
  panel1.Visible := fullpicturemenu.Checked;
  fullmap.visible := fullpicturemenu.Checked;
  Splitter2.Visible := fullpicturemenu.Checked;
end;

procedure Tfrmmain.fullmapAfterTrackingLayerDraw(Sender: TObject;
  hDC: Cardinal);
var
  sym: IMoSymbol;
begin
  sym := IMoSymbol(CreateOleObject('MapObjects2.Symbol'));
  sym.OutlineColor := moRed; //$FF;
  sym.Style := moTransparentFill; //1;
  fullmap.DrawShape(frmmain.mainmap.Extent, sym);
  fullmap.Refresh;
end;

procedure Tfrmmain.fullmapMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: IMoPoint;
begin
  // convert to map points
  p := IMoPoint(CreateOleObject('MapObjects2.point'));
  p := fullmap.ToMapPoint(x, y);
  if IMoRectangle(frmmain.mainmap.extent).ispointin(p) then
    DragFeedbk.DragStart(frmmain.mainmap.Extent, fullmap, x, y);
end;