code.txt

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

procedure Tfrmmain.fullmapMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if shift = [ssleft] then
    if not (DragFeedbk = nil) then
      Dragfeedbk.DragMove(x, y);
end;

procedure Tfrmmain.fullmapMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if not (dragfeedbk = nil) then
    fullmap.Refresh;
  frmmain.mainmap.extent := IMoRectangle(DragFeedbk.DragFinish(x, y));

end;

procedure Tfrmmain.FormCreate(Sender: TObject);
var
  x, y: LongInt;
begin
  DragFeedbk := nil;
  DragFeedbk := TDragFeedback.create;
  frmmain.Scaled := True;
  x := GetSystemMetrics(SM_CXSCREEN); //Screenwidth
  y := GetSystemMetrics(SM_CYSCREEN); //ScreenHeight
 { if (x <> ScreenHeight) or (y <> ScreenWidth) then
  begin
    frmmain.Height := frmmain.Height * x div ScreenHeight; //y-(y div 3);
    frmmain.Width := frmmain.Width * y div ScreenWidth; //x-(x div 3);
    frmmain.ScaleBy(y, ScreenHeight);
    frmmain.Position := poScreenCenter;
  end;
  frmmain.mainmap.BackColor := clMaroon;
  }     /////////////////////////改
end;

procedure Tfrmmain.FormDestroy(Sender: TObject);
begin
  DragFeedbk.Free;
end;

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

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

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

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

procedure Tfrmmain.frmmainpopbackcolorClick(Sender: TObject);
begin
  if frmpicturemanage.layercolordlg.Execute then
    frmmain.mainmap.BackColor := frmpicturemanage.layercolordlg.Color;
  frmmain.mainmap.Refresh;
end;

procedure Tfrmmain.fullmapAfterLayerDraw(Sender: TObject; index: Smallint;
  canceled: WordBool; hDC: Cardinal);
begin
{  if not ((varisempty(g_searchBounds)) and (varisempty(g_selectedBounds))) and fullpicturemenu.Checked
    then exit;
  frmcommon.DrawRecordset(fullmap, recs1, $FF00FF, 0);
  }
end;

procedure Tfrmmain.Panel2Resize(Sender: TObject);
begin
  mapmanagebt.Left := Panel2.Left + (panel2.Width div 2) - (mapmanagebt.Width div 2);
  maplookbt.Left := Panel2.Left + (panel2.Width div 2) - (mapmanagebt.Width div 2);
  maplabelBt.Left := Panel2.Left + (panel2.Width div 2) - (mapmanagebt.Width div 2);
  SpecialpictureBt.Left := Panel2.Left + (panel2.Width div 2) - (mapmanagebt.Width div 2);
  mapcompilebt.Left := Panel2.Left + (panel2.Width div 2) - (mapmanagebt.Width div 2);
end;

procedure Tfrmmain.mapcompilebtClick(Sender: TObject);
begin
  frmdrawmap.show;
end;

procedure Tfrmmain.mainmapAfterLayerDraw(Sender: TObject; index: Smallint;
  canceled: WordBool; hDC: Cardinal);
var
  v : Variant;
begin
  if index=0 then
  fullmap.Refresh ;//   fullmap.TrackingLayer.Refresh(True,v);
end;

end.





//tu ceng guangli

 public

  { Public declarations }
  end;

var
  frmpicturemanage: Tfrmpicturemanage;

implementation
uses main, mapinformationlook, commonunit;

procedure Tfrmpicturemanage.activechecklstbox;
var
  i: integer;
  curlayer: IMoMaplayer;
begin
  layernamechecklistbox.Clear;
  frmquery.frmquerytcComboBox.Clear;
  for i := 0 to frmmain.mainmap.Layers.Count - 1 do
  begin
    curlayer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
    curlayer := IMoMapLayer(frmmain.mainmap.Layers.Item(i));
    layernamechecklistbox.Items.Add(curlayer.name);
    frmquery.frmquerytcComboBox.Items.Add(curlayer.name);
    layernamechecklistbox.Checked[i] := True;
  end;
  //frmquery.frmquerytcComboBox.ItemIndex :=0;
  //frmquery.frmquerytcComboBoxclick(sender);
end;
{$R *.DFM}

procedure Tfrmpicturemanage.mapaddbtClick(Sender: TObject);
var
  name, fname: string;
  dc: IMoDataConnection;
  newitem1: TMenuItem;
  newitem2: TMenuItem;
begin
  if frmmain.Opendialog1.Execute then
  begin
    dc := IMoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
    name := frmmain.opendialog1.filename;
    fname := extractfiledir(name);
    dc.database := fname; ///'[CADLine]c:';//
    if not dc.connect then exit;
    while pos('\', name) > 0 do
    begin
      delete(name, 1, 1);
    end;
    while pos('.', name) > 0 do
      delete(name, pos('.', name), 4);
    gs := dc.FindGeoDataset(name);
    if varisempty(gs) then exit;
    newitem1 := TMenuItem.Create(Self);
    newitem2 := TMenuItem.Create(Self);
    newitem1.Caption := name;
    newitem2.Caption := name;
    frmmain.mappopupmenuchoice.Add(newitem1);
    frmmain.mappopupmenudel.Add(newitem2);
////////////////调用过程///////////////////
    frmmain.frmmainstatusbar.Panels.Items[2].Text := '当前层: ' + name;
    frmcommon.mapcounts := frmcommon.mapcounts + 1; //获取每个图层的图层名及其路经
    frmcommon.mapname[frmcommon.mapcounts] := name; //获取每个图层的图层名及其路经
    frmcommon.maproadpath[frmcommon.mapcounts] := fname; //获取每个图层的图层名及其路经
    frmmain.mapadd(frmmain.mainmap,name);
    frmmain.fullmap.Layers.Clear;
    frmmain.mapadd(frmmain.fullmap,name);
    frmpicturemanage.activechecklstbox;
 //  frmquery.frmqueryactive(name);
////////////////调用过程///////////////////
  end;
end;


procedure Tfrmpicturemanage.layernameCheckListBoxClick(Sender: TObject);
var
  i: integer;
  mylayer: IMoMaplayer;
  visiblelayercount: Integer;
  layers: IMoLayers;
  layer: IMoMapLayer;
  sym: IMoSymbol;
begin
 // currenttcindex :=layernamechecklistbox.ItemIndex;

  if currenttcindex<>-1 then
  begin//////////////////
  visiblelayercount := 0;
  for i := 0 to frmmain.mainmap.Layers.Count - 1 do
  begin
    mylayer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
    mylayer := IMoMaplayer(frmmain.mainmap.Layers.Item(i));
    mylayer.Visible := layernamechecklistbox.Checked[i];
    if mylayer.Visible then
      visiblelayercount := visiblelayercount + 1;
  end;
  if visiblelayercount = 0 then
  begin
    colorlbl.Caption := '没有图层显示';
    colorlbl.Color := clWhite;
  end
  else
    colorlbl.Caption := ' ';
  if layernamechecklistbox.Checked[currenttcindex] then
  begin
    layers := IMoLayers(frmmain.mainmap.layers);
    layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
    layer := IMoMapLayer(layers.item(currenttcindex));
    sym := IMoSymbol(layer.symbol);
    colorlbl.Color := sym.Color;
  end
  else
  begin
    colorlbl.Color := clWhite;
    colorlbl.Caption := '图层未被选中';
  end;
  frmmain.mainmap.Refresh;
 end ;

end;



procedure Tfrmpicturemanage.movetopbtClick(Sender: TObject);
begin
  frmmain.mainmap.Layers.MoveTo(currenttcindex, 0);
  frmquery.lookMap.Layers.MoveTo(currenttcindex, 0);
  layernamechecklistbox.Items.Move(currenttcindex, 0);
  frmmain.mainmap.Refresh;
end;


procedure Tfrmpicturemanage.moveupbtClick(Sender: TObject);
begin
  if currenttcindex = 0 then exit;
  frmmain.mainmap.Layers.MoveTo(currenttcindex, currenttcindex - 1);
  frmquery.lookMap.Layers.MoveTo(currenttcindex, currenttcindex - 1);
  layernamechecklistbox.Items.Move(currenttcindex, currenttcindex - 1);
  frmmain.mainmap.Refresh;
end;

procedure Tfrmpicturemanage.movedownbtClick(Sender: TObject);
begin
  if currenttcindex = frmmain.mainmap.Layers.Count - 1 then exit;
  frmmain.mainmap.Layers.MoveTo(currenttcindex, currenttcindex + 1);
  frmquery.lookmap.Layers.MoveTo(currenttcindex, currenttcindex + 1);
  layernamechecklistbox.Items.Move(currenttcindex, currenttcindex + 1);
  frmmain.mainmap.Refresh;
end;

procedure Tfrmpicturemanage.movebottonbtClick(Sender: TObject);
begin
  frmmain.mainmap.Layers.MoveTo(currenttcindex, frmmain.mainmap.Layers.Count - 1);
  frmquery.lookMap.Layers.MoveTo(currenttcindex, frmmain.mainmap.Layers.Count - 1);
  layernamechecklistbox.Items.Move(currenttcindex, frmmain.mainmap.Layers.Count - 1);
  frmmain.mainmap.Refresh;
end;

procedure Tfrmpicturemanage.picturemanagedeletebtClick(Sender: TObject);
begin
  if deltcindex = -1 then
    Application.MessageBox('请选择要删除的图层', '提示', MB_OK)
  else
  begin
    frmmain.mainmap.Layers.Remove(deltcindex);
    frmmain.fullmap.Layers.Remove(deltcindex);
    frmquery.lookMap.Layers.Remove(deltcindex);
    layernamechecklistbox.Items.Delete(deltcindex);
    frmquery.frmquerytcComboBox.Items.Delete(deltcindex);
    deltcindex := -1;
    frmmain.mainmap.Refresh;
    frmmain.fullmap.Refresh ;
  end;
end;

procedure Tfrmpicturemanage.layernameCheckListBoxMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  mousepoint: TPoint;
begin
  mousepoint.x := X; //////////////////////////////////////////////////
  mousepoint.y := Y;
  deltcindex := layernamechecklistbox.ItemAtPos(mousepoint, True);
  currenttcindex := layernamechecklistbox.ItemAtPos(mousepoint, True);
  if deltcindex<>-1 then
  frmcommon.picturemanagecolorlblcolor(deltcindex);
end;

procedure Tfrmpicturemanage.FormActivate(Sender: TObject);
begin
//  deltcindex := -1;
  //currenttcindex := -1;
end;

procedure Tfrmpicturemanage.colorlblClick(Sender: TObject);
var
  layers: IMoLayers;
  layer: IMoMapLayer;
  sym: IMoSymbol;
begin
  if layernamechecklistbox.ItemIndex > -1 then
  begin
    if layercolordlg.Execute then
    begin
      layers := IMoLayers(frmmain.mainmap.layers);
      layer := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
      layer := IMoMapLayer(layers.item(layernamechecklistbox.ItemIndex));
      sym := IMoSymbol(layer.symbol);
      sym.color := layercolordlg.Color;
      colorlbl.Color := layercolordlg.Color;
      frmmain.mainmap.Refresh;
    end;
  end
  else
    Application.MessageBox('没有选择图层,请选择你想要改变颜色的图层', '提示', MB_OK);
end;


{procedure Tfrmpicturemanage.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  str: string;
  lys: IMoLayers;
  ly: IMoMapLayer;
  i, j: Integer;
  dc: IMoDataConnection;
begin
  if frmmain.mainmap.Layers.Count >0 then
  begin
  ////////将最上面的图层加入fullmap
  j := 0;
  frmmain.fullmap.Layers.Clear;
  lys := IMoLayers(frmmain.mainmap.Layers);
  ly := IMoMapLayer(CreateOleObject('MapObjects2.MapLayer'));
  ly := IMoMapLayer(lys.item(0));
  str := ly.Name;
  for i := 0 to frmcommon.mapcounts do
  begin
    if frmcommon.mapname[i] = str then j := i;
  end;

  dc := IMoDataConnection(CreateOleObject('MapObjects2.DataConnection'));
  dc.database := frmcommon.maproadpath[j];
  if not dc.connect then exit;
  gs := dc.FindGeoDataset(str);
  ly.GeoDataset := gs;
  lys := frmmain.fullmap.Layers;
  lys.Add(ly);
  frmmain.fullmap.Refresh;
  end;
  frmpicturemanage.Hide;
end;
 }
procedure Tfrmpicturemanage.FormCreate(Sender: TObject);
begin
deltcindex := -1;
  currenttcindex := -1;
end;

end.