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

📄 searchfrm.pas

📁 Delphi + MapX程序框架(地图)源码程序
💻 PAS
字号:
unit SearchFrm;

interface
{说明:
     1。单元功能:搜索地图对象}

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, Menus, MapX, MapXLib_TLB;

type
  TfrmSearch = class(TForm)
    Panel1: TPanel;
    GroupBox4: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton2: TSpeedButton;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Splitter4: TSplitter;
    ListView1: TListView;
    procedure SpeedButton2Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
    procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
      Data: Integer; var Compare: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FMapX: TMapX;
    FColumnToSort :Integer;

    FSearchType: TSearchType;
    FSearchFtrs: CMapXFeatures; //找到的对象

    FStatusDrawRect: TRect;
    FProgressBar: TProgressBar;

    procedure CreateProgressBar(MinValue,MaxValue: Integer);
    procedure FillData(Fs: CMapXFeatures; Lyr: string);
  public
    { Public declarations }
    procedure SetBuddyMap(AMapX: TMapX);
  end;

implementation

{$R *.dfm}

procedure TfrmSearch.FormShow(Sender: TObject);
var
  AList: TStringList;
begin
  if Assigned(FMapX)then
  begin
    AList:= TStringList.Create;
    FMapX.Get_Layers(AList);
    ComboBox1.Items.Assign(AList);
    ComboBox1.Text:= FMapX.WorkLayer;
    ComboBox1Change(nil);
    AList.Free;
  end;
  FSearchType:= stArbitraryDim;
end;

procedure TfrmSearch.SpeedButton2Click(Sender: TObject);
begin
  ModalResult:= mrCancel;
end;

procedure TfrmSearch.ComboBox1Change(Sender: TObject);
var
  i: integer;
  DataSet: CMapXDataSet;
begin
  ComboBox2.Clear;
  FSearchFtrs:= nil;
  if ComboBox1.Text <> '' then
  begin
    FMapX.BindLayerData(ComboBox1.Text);
    DataSet:= FMapX.GetDataSetByName(ComboBox1.Text);
    for i:= 1 to DataSet.Fields.Count do
      ComboBox2.Items.Add(DataSet.Fields.Item[I]._Name);
    if ComboBox2.Items.Count > 0 then
      ComboBox2.ItemIndex:= 0;
  end;
end;

procedure TfrmSearch.RadioButton1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
    FSearchType:= stLeftDim;
end;

procedure TfrmSearch.RadioButton2Click(Sender: TObject);
begin
  if RadioButton2.Checked then
    FSearchType:= stRightDim;
end;

procedure TfrmSearch.RadioButton3Click(Sender: TObject);
begin
  if RadioButton3.Checked then
    FSearchType:= stArbitraryDim;
end;

procedure TfrmSearch.RadioButton4Click(Sender: TObject);
begin
  if RadioButton4.Checked then
    FSearchType:= stExact;
end;

procedure TfrmSearch.SpeedButton1Click(Sender: TObject);
begin
  if (ComboBox1.Text = '') or (ComboBox2.Text = '') or (Edit1.Text = '') then
  begin
    Application.MessageBox('配置信息不全,无法进行搜索!','提示信息',mb_ok);
    Exit;
  end;
  FSearchFtrs:= FMapX.GetSearchResult(ComboBox1.Text,ComboBox2.Text,Edit1.Text,FSearchType);
  StatusBar1.Panels.Items[0].Text:= '  共找到 '+IntToStr(FSearchFtrs.Count)+' 个对象';
  FillData(FSearchFtrs,ComboBox1.Text);
end;

procedure TfrmSearch.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  FStatusDrawRect:=rect; //记录要实现状态条特技的坐标范围
end;

//在地图上显示对象
procedure TfrmSearch.SpeedButton3Click(Sender: TObject);
begin
  if Assigned(FSearchFtrs) then
    FMapX.SetLayerSelection(False,False,FSearchFtrs,ComboBox1.Text);
end;

procedure TfrmSearch.ListView1ColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  FColumnToSort := Column.Index;
  (Sender as TCustomListView).AlphaSort;
end;

procedure TfrmSearch.ListView1Compare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  Index: Integer;
begin
  if FColumnToSort = 0 then
    Compare := CompareText(Item1.Caption,Item2.Caption)
  else begin
   Index := FColumnToSort - 1;
   Compare := CompareText(Item1.SubItems[Index],Item2.SubItems[Index]);
  end;
end;


procedure TfrmSearch.FillData(Fs: CMapXFeatures; Lyr: string);
var
  MyDataSet: CMapXDataSet;
  NewColumn: TListColumn;
  NewItem: TListItem;
  i,j: integer;
begin
  ListView1.Columns.Clear;
  ListView1.Clear;

  MyDataSet:= FMapX.GetDataSetByName(Lyr);
  //创建字段
  for i:= 1 to MyDataSet.Fields.Count do
  begin
    NewColumn:= ListView1.Columns.Add;
    NewColumn.Width:=100;
    NewColumn.Caption:=MyDataSet.Fields.item[i].Name;
  end;

  if Fs.Count > 0 then
    CreateProgressBar(1,Fs.Count)
  else
    Exit;

  //填入内容
  for i:= 1 to Fs.Count do
  begin
    NewItem:= ListView1.Items.Add;
    if MyDataSet._Value[Fs.item[i].FeatureKey,1] <> null then
      NewItem.Caption:= MyDataSet.Value[Fs.item[i].FeatureKey,1]
    else NewItem.Caption:= '';  {非常有必要把它赋直为空,
                                    否则在排序的时候会因为找不到直而报错}
    if MyDataSet.Fields.Count >= 2 then
      for j:= 2 to MyDataSet.Fields.Count do
        if MyDataSet._Value[Fs.item[i].FeatureKey,j] <> null then
          NewItem.SubItems.Add(MyDataSet._Value[Fs.item[i].FeatureKey,j])
        else  NewItem.SubItems.Add('');
    if Assigned(FProgressBar) then
       FProgressBar.Position:= i;
    Application.ProcessMessages;
  end;
  FProgressBar.Free;
end;


procedure TfrmSearch.CreateProgressBar(MinValue, MaxValue: Integer);
begin
  FProgressBar:= TProgressBar.Create(Self);
  StatusBar1.Repaint;
  with FProgressBar do
  begin
    //设定进程条的宽度和高度
    Top:= FStatusDrawRect.top;
    Left:= FStatusDrawRect.left;
    Width:= FStatusDrawRect.right- FStatusDrawRect.left;
    Height:= FStatusDrawRect.bottom-FStatusDrawRect.top;
    Parent := StatusBar1; //该进程条的拥有者为状态条status
    Max:= MaxValue;
    Min:= MinValue;
    Visible:=true;
  end; //with
end;

procedure TfrmSearch.SetBuddyMap(AMapX: TMapX);
begin
  if FMapX <> AMapX then
    FMapX:= AMapX;
end;

end.

⌨️ 快捷键说明

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