⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitsearch.pas

📁 此代码是关于mapgis的在
💻 PAS
字号:
unit UnitSearch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ComCtrls, MapXLib_TLB, ExtCtrls, YHBListBox, Grids,
  yhbGrid, NumberEditUnit, ActiveX;

type
  TFrame_Search = class(TFrame)
    Label1: TLabel;
    Label2: TLabel;
    OperCombo: TComboBox;
    FieldsCombo: TComboBox;
    ValuesCombo: TComboBox;
    LayersCombo: TComboBox;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    BtnAdd: TButton;
    Button4: TButton;
    Button3: TButton;
    ConditionList: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure LayersComboChange(Sender: TObject);
    procedure BtnAddClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FieldsComboChange(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    FMapX: TMapXObject;
    function GetCurrentConditionString:string;
    function GetCurrentFields:CMapxFields;
    function GetCurrentField:CMapXField;
    function GetFieldSQLValue(fldType:TOleEnum; Value:string):string;
    function CheckInput:Boolean;
  public
    { Public declarations }
    procedure LoadLayers;
    property MapX:TMapXObject read FMapX write FMapX;
  end;

implementation

uses MapXAPIs, BusinessDialogs, StringOperations, UnitShellAPIs;

{$R *.dfm}

{ TFrame_Search }

procedure TFrame_Search.LoadLayers;
var
  i:Integer;
  Lyr:Layer;
begin
  FieldsCombo.Items.Clear;
  LayersCombo.Items.BeginUpdate;
  try
    LayersCombo.Items.Clear;
    for i:=1 to FMapX.Layers.Count do
    begin
      Lyr:=FMapX.Layers.Item[i];
      if IsCustomLayer(Lyr) then
        LayersCombo.Items.Add(Lyr.Name);
    end;
    if LayersCombo.Items.Count>0 then
    begin
      LayersCombo.ItemIndex:=0;
      LayersCombo.OnChange(LayersCombo);
    end;
  finally
    LayersCombo.Items.EndUpdate;
  end;   
end;

procedure TFrame_Search.Button1Click(Sender: TObject);
var
  lyr :CmapxLayer;
  ds :CMapxDataset;
  ftrs :Cmapxfeatures;
  Seed:Double;
begin
  if LayersCombo.ItemIndex=-1 then Exit;
  ConditionList.Items.Text:=Trim(ConditionList.Items.Text);
  if ConditionList.Items.Text='' then
    WarningAbort('提示', '请输入查询条件!');
  lyr:=MapX.Layers.Item[GetCustomLayerIndex(FMapX, LayersCombo.ItemIndex)];
  ds:=MapX.datasets.Add(miDatasetLayer,lyr,
                        EmptyParam,emptyparam,emptyparam,
                        emptyparam,emptyparam,emptyparam);
  try
    ftrs:=lyr.Search(ConditionList.Items.Text, EmptyParam);
    SelectFeatures(MapX, lyr, ftrs, False);
    Seed:=MapX.Bounds.Width/8;
    GoToFeatures(MapX, ftrs, True, Seed);
  except
    MyDefInformation('无法查询,可能查询条件有误!');
  end;
end;

procedure TFrame_Search.LayersComboChange(Sender: TObject);
var
  i:Integer;
  lyr :CmapxLayer;
  flds:CmapxFields;
begin
  FieldsCombo.Items.BeginUpdate;
  try
    FieldsCombo.Items.Clear;
    if LayersCombo.ItemIndex>-1 then
    begin
      lyr:=MapX.Layers.Item[GetCustomLayerIndex(FMapX, LayersCombo.ItemIndex)];
      if lyr.DataSets.Count=0 then Exit;
      flds:=lyr.DataSets.Item[1].Fields;
      for i:=1 to flds.Count do
        FieldsCombo.Items.Add(flds.Item[i].Name);
      if FieldsCombo.Items.Count>0 then
        FieldsCombo.ItemIndex:=0;
    end;
  finally
    FieldsCombo.Items.EndUpdate;
  end;
end;

procedure TFrame_Search.BtnAddClick(Sender: TObject);
begin
  if not CheckInput then Exit;
  ConditionList.Items.Add(GetCurrentConditionString);
end;

procedure TFrame_Search.Button3Click(Sender: TObject);
begin
  ConditionList.Items.Clear;
end;

procedure TFrame_Search.Button5Click(Sender: TObject);
begin
  ConditionList.Items.Add('and');
end;

procedure TFrame_Search.Button6Click(Sender: TObject);
begin
  ConditionList.Items.Add('or');
end;

procedure TFrame_Search.Button7Click(Sender: TObject);
begin
  ConditionList.Items.Add('not');
end;

function TFrame_Search.GetCurrentConditionString: string;
var
  fld:CMapXField;
begin
  Result:='';
  fld:=GetCurrentField;
  if fld<>nil then
    Result:=fld.Name+OperCombo.Text+GetFieldSQLValue(fld.TypeEx, ValuesCombo.Text);
end;

function TFrame_Search.GetCurrentFields: CmapxFields;
var
  lyr :CmapxLayer;
begin
  Result:=nil;
  lyr:=MapX.Layers.Item[GetCustomLayerIndex(FMapX, LayersCombo.ItemIndex)];
  if lyr.DataSets.Count>0 then
    Result:=lyr.DataSets.Item[1].Fields;
end;

function TFrame_Search.GetCurrentField: CMapXField;
var
  i:Integer;
  flds:CMapxFields;
begin
  Result:=nil;
  flds:=GetCurrentFields;
  if flds=nil then Exit;
  for i:=1 to flds.Count do
    if AnsiCompareText(flds.Item[i].Name, FieldsCombo.Text)=0 then
    begin
      Result:=flds.Item[i];
      Exit;
    end;
end;

function TFrame_Search.GetFieldSQLValue(fldType: TOleEnum;
  Value: string): string;
begin
  case fldType of
    miTypeString:
      Result:=''''+Value+'''';
    miTypeNumeric, miTypeFloat,
    miTypeInteger, miTypeSmallInt:
      Result:=Value;
    miTypeDate:
      Result:=''''+Value+'''';
    miTypeLogical:
      if Value='是' then
        Result:='True'
      else
        Result:='False';
  end;
end;

procedure TFrame_Search.FieldsComboChange(Sender: TObject);
var
  fld:CMapXField;
begin
  ValuesCombo.Items.Clear;
  fld:=GetCurrentField;
  if (fld<>nil)and(fld.TypeEx=miTypeLogical) then
  begin
    ValuesCombo.Items.Add('是');
    ValuesCombo.Items.Add('否');
  end;
end;

procedure TFrame_Search.Button4Click(Sender: TObject);
var
  PriorValue:string;
begin
  if ConditionList.ItemIndex=-1 then
    BtnAdd.OnClick(BtnAdd)
  else
  begin
    if not CheckInput then Exit;
    ConditionList.Items.Insert(ConditionList.ItemIndex, GetCurrentConditionString);
  end;
end;

function TFrame_Search.CheckInput: Boolean;
var
  fld:CMapXField;
begin
  Result:=True;
  ValuesCombo.Items.Clear;
  fld:=GetCurrentField;
  if fld<>nil then
  begin
    case fld.TypeEx of
      miTypeNumeric,
      miTypeFloat,
      miTypeInteger,
      miTypeSmallInt:begin
        ValuesCombo.Text:=Trim(ValuesCombo.Text);
        if ValuesCombo.Text='' then
        begin
          MyDefInformation('请输入整数值!');
          Result:=False;
          Exit;
        end;
      end;
      miTypeDate:begin
        ValuesCombo.Text:=Trim(ValuesCombo.Text);
        if ValuesCombo.Text='' then
        begin
          MyDefInformation('请输入日期值!');
          Result:=False;
          Exit;
        end;
        if not IsDateTime(ValuesCombo.Text) then
        begin
          MyDefInformation('日期值格式错误!');
          Result:=False;
          Exit;
        end;
      end;
      miTypeLogical:begin
        ValuesCombo.Text:=Trim(ValuesCombo.Text);
        if (ValuesCombo.Text<>'是')and(ValuesCombo.Text<>'否') then
        begin
          MyDefInformation('请输入“是”或“否”!');
          Result:=False;
          Exit;
        end;
      end;
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -