unitnewlayer.pas

在delphi下基于MapX5.0的GIS程序

unit UnitNewLayer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, MapXLib_TLB, Buttons, ExtCtrls;

type
  TFrmNewLayer = class(TForm)
    EditLayerName: TEdit;
    tableNameLabel: TLabel;
    Label1: TLabel;
    CBoxLayerType: TComboBox;
    BitBtnOK: TBitBtn;
    BitBtnCancel: TBitBtn;
    TimerInfo: TTimer;
    procedure BitBtnOKClick(Sender: TObject);
    procedure CBoxLayerTypeChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TimerInfoTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmNewLayer: TFrmNewLayer;
  SQLString: String;
  CanAddLayer: Boolean;
  OnShowing: Boolean;

implementation

uses UnitMain, UnitLayerControl, UnitDataModule, UnitCommonModule;

{$R *.DFM}

// 画窗体边框
procedure TFrmNewLayer.WMNCPaint(var Msg: TWMNCPaint);
var
  dc : hDc;
  Pen : hPen;
  OldPen : hPen;
  OldBrush : hBrush;
begin
  inherited;
  dc := GetWindowDC(Handle);
  msg.Result := 1;
  Pen := CreatePen(PS_SOLID, 2, RGB(255, 0, 0));
  OldPen := SelectObject(dc, Pen);
  OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
  if OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height+5);
  if Not TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height);
  if Not OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height-5);
  SelectObject(dc, OldBrush);
  SelectObject(dc, OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle, Canvas.Handle);
end;

procedure TFrmNewLayer.BitBtnOKClick(Sender: TObject);
var
  Flds: Variant;
  lyrs: Variant;
  lyrinfo: MapXLib_TLB.CMapXLayerInfo;
  i: Integer;
begin
// 判断图层是否已经建立
  CanAddLayer := True;
  for i:=0 to FrmLayerControl.ListBoxLayers.Items.Count-1 do
    if FrmLayerControl.ListBoxLayers.Items[i] = EditLayerName.Text then CanAddLayer := False;
  if CanAddLayer then
  begin
    try
  // 新建图层
      Flds:=Mapxlib_tlb.CoFields.Create;
      Flds.AddStringField('Name', 30, False);
      Flds.AddStringField('ID',20, True);
      lyrinfo:=Mapxlib_tlb.CoLayerInfo.Create;
      lyrinfo.Type_ :=milayerinfoTypeNewTable;
      lyrinfo.AddParameter('Filespec', ExeFilePath+'Maps\'+EditLayerName.Text+'.TAB');
      lyrinfo.AddParameter('Name',EditLayerName.Text);
      lyrinfo.AddParameter('Fields',Flds);
      lyrs:=GMap.Layers.Add(lyrinfo,1);

      With FrmLayerControl do
      begin
        ListBoxLayers.Items.Insert(0, EditLayerName.Text);
        SelectLayerNum:=1;
        Control_UpDownBtn;
        View_PropertyPan;
      end;
      except
        on E:Exception Do MessageDlg('新图层创建错误！', mtError, [mbOk], 0);
      end;  //Try
      Close;
  end else Application.MessageBox('图层已经建立，不能重复建立！', '提示', MB_OK)

end;

procedure TFrmNewLayer.CBoxLayerTypeChange(Sender: TObject);
begin  
  EditLayerName.Text := CBoxLayerType.Text;
end;

procedure TFrmNewLayer.FormShow(Sender: TObject);
var
  Str: String;
begin
  TimerInfo.Enabled := True;
  OnShowing := True;

// Open DM.ADOQueryLayerToTable
  OpenADOQueryAll(DM.ADOQueryLayerToTable, '图与表');
// Fill CBoxLayerType
  DM.ADOQueryLayerToTable.First;
  while Not DM.ADOQueryLayerToTable.Eof do
  begin
    Str := DM.ADOQueryLayerToTable.FieldByName('MapLayer').AsString;
    CBoxLayerType.Items.Add(Str);
    DM.ADOQueryLayerToTable.Next;
  end;
  CBoxLayerType.Text := CBoxLayerType.Items[0];
  EditLayerName.Text := CBoxLayerType.Text;
end;

procedure TFrmNewLayer.TimerInfoTimer(Sender: TObject);
begin
  if OnShowing then
  begin
    Height := Height + 5;
    if Height > 100 then TimerInfo.Enabled := False;
  end
  else
  begin
    Height := Height - 5;
    if Height < 30 then
    begin
      TimerInfo.Enabled := False;
      Close;
    end;
  end; 
end;

procedure TFrmNewLayer.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Height > 30 then
  begin
    CanClose := False;
    OnShowing := False;
    TimerInfo.Enabled := True;
  end;  
end;

end.