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

📄 unitsearch.~pas

📁 在delphi下基于MapX5.0的GIS程序
💻 ~PAS
字号:
unit UnitSearch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DB, Grids, DBGrids, MapXLib_TLB, ExtCtrls;

type
  TFrmSearch = class(TForm)
    GBoxAll: TGroupBox;
    LabelType: TLabel;
    EditAll: TEdit;
    SBtnSearchAll: TSpeedButton;
    SBtnAllClear: TSpeedButton;
    CBoxType: TComboBox;
    GBoxBus: TGroupBox;
    SBtnBusSearch: TSpeedButton;
    EditBusSStation: TEdit;
    EditBusEStation: TEdit;
    SBtnBusLEStationClear: TSpeedButton;
    SBtnBusSStationClear: TSpeedButton;
    GBoxNearInf: TGroupBox;
    SBtnNearInfSearch: TSpeedButton;
    SBtnNearInfClear: TSpeedButton;
    EditNearInf: TEdit;
    CBoxNearInfDistance: TComboBox;
    LabelNearInfDistance: TLabel;
    LabelNearInfType: TLabel;
    CBoxNearInfType: TComboBox;
    TimerSearch: TTimer;
    BBtnClose: TBitBtn;
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure SetIniFrmSearch();
    procedure FormShow(Sender: TObject);
    procedure TimerSearchTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SBtnSearchAllClick(Sender: TObject);
    procedure SBtnAllClearClick(Sender: TObject);
    procedure EditAllKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SBtnNearInfSearchClick(Sender: TObject);
    procedure SBtnNearInfClearClick(Sender: TObject);
    procedure SBtnBusSearchClick(Sender: TObject);
    procedure SBtnBusSStationClearClick(Sender: TObject);
    procedure SBtnBusLEStationClearClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSearch: TFrmSearch;
  OnShowing: Boolean;

implementation

uses UnitDataModule, UnitMain, UnitCommonModule, UnitSearchResult,
  UnitCenterFeature, UnitByBus, UnitSearchResultBus_Way;

{$R *.dfm}


procedure TFrmSearch.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 TimerSearch.Enabled then Windows.Rectangle(dc, 0, 0, Width+5, Height);
  if Not TimerSearch.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height);
  if Not OnShowing and TimerSearch.Enabled then Windows.Rectangle(dc, 0, 0, Width-5, Height);
  SelectObject(dc, OldBrush);
  SelectObject(dc, OldPen);
  DeleteObject(Pen);
  ReleaseDC(Handle, Canvas.Handle);
end;


// 修改窗体的初始化设置
procedure TFrmSearch.SetIniFrmSearch();
var
  i: Integer;
begin
// 加载图层显示管理  编辑图层
  CBoxType.Clear;
  CBoxType.Items.Add('全部类别');
  CBoxNearInfType.Clear;
  CBoxNearInfType.Items.Add('全部类别');
  for i := 2 to FrmMain.Map1.Layers.Count do
  begin
    CBoxType.Items.Add(LayerToFtTypeArr[i].TypeName);
    CBoxNearInfType.Items.Add(LayerToFtTypeArr[i].TypeName);
  end;
  CBoxType.ItemIndex := 0;
  CBoxNearInfType.ItemIndex := 0;
//  SearchLayer := 
end;

procedure TFrmSearch.FormShow(Sender: TObject);
begin
  Top := 95;
  Left := 2;
  Width := 0;
  Height := 454;
  OnShowing := True;
  TimerSearch.Enabled := True;

  SetIniFrmSearch();
end;

procedure TFrmSearch.TimerSearchTimer(Sender: TObject);
begin
  if OnShowing then
  begin
    Width := Width + 5;
    if Width > 165 then TimerSearch.Enabled := False;
  end
  else
  begin
    Width := Width - 5;
    if Width < 25 then
    begin
      TimerSearch.Enabled := False;
      Close;
    end;
  end;
end;

procedure TFrmSearch.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Width > 25 then
  begin
    CanClose := False;
    OnShowing := False;
    TimerSearch.Enabled := True;
  end;
end;

procedure TFrmSearch.SBtnSearchAllClick(Sender: TObject);
begin
  if CBoxType.Text = '全部类别' then
    EditLayer := FrmMain.Map1.Layers['标记']
  else EditLayer := FrmMain.Map1.Layers[CBoxType.Text];

//  模糊查询
  OpenADOQueryAllL(DM.ADOQuerySearchAll, EditLayer.Name, EditAll.Text);
// 添加查询结果显示框
  if DM.ADOQuerySearchAll.RecordCount > 0 then
  begin
    FillResultData();
    FrmSearchResultBus_Way.Hide;
    FrmSearchResult.Show;
    FrmSearchResult.Caption := '模糊查询结果';
    FrmSearchResult.PanelTitle.Caption := '请选择查询结果';
    FrmSearchResult.PanelResultNum.Caption := '共查出:'+IntToStr(DM.ADOQuerySearchAll.RecordCount)+'条记录';
    FrmSearchResult.BBtnFind.SetFocus;
  end else Application.MessageBox('满足条件的信息没有找到!', '提示', MB_OK);
end;

procedure TFrmSearch.SBtnAllClearClick(Sender: TObject);
begin
  EditAll.Clear;
  EditAll.SetFocus;
end;

procedure TFrmSearch.EditAllKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = 13 then SBtnSearchAllClick(Sender);
end;

procedure TFrmSearch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//  FrmMain.NSearchWindowsClick(FrmMain);
end;

procedure TFrmSearch.SBtnNearInfSearchClick(Sender: TObject);
begin
//  模糊查询
  OpenADOQueryAllL(DM.ADOQueryCenterFind, '标记', EditNearInf.Text);
  FrmCenterFeature.ShowModal;
end;

procedure TFrmSearch.SBtnNearInfClearClick(Sender: TObject);
begin
  EditNearInf.Clear;
  EditNearInf.SetFocus;
end;

procedure TFrmSearch.SBtnBusSearchClick(Sender: TObject);
begin
  FrmByBus.ShowModal;
end;

procedure TFrmSearch.SBtnBusSStationClearClick(Sender: TObject);
begin
  EditBusSStation.Clear;
  EditBusSStation.SetFocus;
end;

procedure TFrmSearch.SBtnBusLEStationClearClick(Sender: TObject);
begin
  EditBusEStation.Clear;
  EditBusEStation.SetFocus;
end;

end.

⌨️ 快捷键说明

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