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

📄 unitsearchresult.~pas

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

interface

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

type
  TFrmSearchResult = class(TForm)
    TimerSearchResult: TTimer;
    TimerFlash: TTimer;
    BBtnFind: TBitBtn;
    GBoxInfo: TGroupBox;
    LabelName: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    LabelLayer: TLabel;
    LabelType: TLabel;
    Label4: TLabel;
    BBtnViewInfo: TBitBtn;
    Label3: TLabel;
    TBarZoom: TTrackBar;
    BBtnClose: TBitBtn;
    PanelResultNum: TPanel;
    PanelTitle: TPanel;
    DSResult: TDataSource;
    DBGridResult: TDBGrid;
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure TimerSearchResultTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure TimerFlashTimer(Sender: TObject);
    procedure DBGridResultDrawColumnCell(Sender: TObject;
      const Rect: TRect; DataCol: Integer; Column: TColumn;
      State: TGridDrawState);
    procedure BBtnViewInfoClick(Sender: TObject);
    procedure TBarZoomChange(Sender: TObject);
    procedure BBtnFindClick(Sender: TObject);
    procedure DBGridResultDblClick(Sender: TObject);
    procedure DBGridResultKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DBGridResultMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSearchResult: TFrmSearchResult;
  OnShowing: Boolean;
  iNum: Integer=0;

implementation

uses UnitDataModule, UnitMain, UnitCommonModule, UnitComInfo, UnitCompanys,
  UnitComWay, UnitLabelInfo;

{$R *.dfm}

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

procedure TFrmSearchResult.TimerSearchResultTimer(Sender: TObject);
begin
  if OnShowing then
  begin
    Left := Left - 5;
    Width := Width + 5;
    if Width > 165 then TimerSearchResult.Enabled := False;
  end
  else
  begin
    Left := Left + 5;
    Width := Width - 5;
    if Width < 25 then
    begin
      TimerSearchResult.Enabled := False;
      Close;
    end;
  end;
end;

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

procedure TFrmSearchResult.FormShow(Sender: TObject);
begin
  Top := 95;
  Left := 776;
  Width := 0;
  Height := 454;
  OnShowing := True;
  TimerSearchResult.Enabled := True;
end;

procedure TFrmSearchResult.TimerFlashTimer(Sender: TObject);
begin
  iNum := (iNum + 1) mod 2;
  with FrmMain do
  begin
   if iNum = 0 then Map1.Layers.Item[LabelLayer.Caption].Selection.ClearSelection
     else Map1.Layers.Item[LabelLayer.Caption].Selection.SelectByPoint(infoFeature.CenterX, infoFeature.CenterY, miSelectionAppend, miSearchResultDefault);
  end;
end;

procedure TFrmSearchResult.DBGridResultDrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
begin
  DBGridResult.Canvas.Brush.Color := clRed;
end;

procedure TFrmSearchResult.BBtnViewInfoClick(Sender: TObject);
begin
// 定位
  BBtnFindClick(Sender);
  if FeatureFound then
  begin
    EditLayer := FrmMain.Map1.Layers[LabelLayer.Caption];
    InfoLayerName := LabelLayer.Caption;
    if FrmSearchResult.Caption = '修改查询结果' then
      infFormViewType := SELECT_FEATURE
    else
    begin
      infFormViewType := SEARCH_FEATURE;
      TimerFlash.Enabled := True;
    end;
  // 根据类型而选择窗口
    if (LabelLayer.Caption = '企事业') then FrmCompanysInfo.ShowModal
    else
    if (LabelLayer.Caption = '公交线路') or
       (LabelLayer.Caption = '轻轨线路') then FrmComWay.ShowModal
    else
    if (LabelLayer.Caption = '地理区域') or
       (LabelLayer.Caption = '水系') or
       (LabelLayer.Caption = '居民区') or
       (LabelLayer.Caption = '绿地') or
       (LabelLayer.Caption = '街道') or
       (LabelLayer.Caption = '公交站点') then FrmComInfo.ShowModal;
  end;
end;

procedure TFrmSearchResult.TBarZoomChange(Sender: TObject);
begin
  if CanChangeZoom then
    FrmMain.Map1.ZoomTo((TBarZoom.Position+1)*20, infoFeature.CenterX, infoFeature.CenterY);
end;

procedure TFrmSearchResult.BBtnFindClick(Sender: TObject);
begin
  // 定位
  CanChangeZoom := True;
  With FrmMain do
  begin
    FoundObj := Map1.Layers[LabelLayer.Caption].Find.Search(PYConvert(LabelName.Caption), '');
    if (FoundObj.Findrc Mod 10 = 1) then
    begin
       FeatureFound := True;  
       Map1.ZoomTo((TBarZoom.Position+1)*25, FoundObj.CenterX, FoundObj.CenterY);
       Map1.Layers.ClearSelection;
       Map1.Layers[LabelLayer.Caption].Selection.SelectByPoint(FoundObj.CenterX, FoundObj.CenterY, miSelectionAppend, miSearchResultDefault);
       Map1.Layers[LabelLayer.Caption].KeyField := 'ID';
       infoFeature := Map1.Layers[LabelLayer.Caption].Selection.Item[1];
    end
    else begin
           Application.MessageBox('信息不能定位!', '提示', MB_OK);
           FeatureFound := False;
         end;
  end;
end;

procedure TFrmSearchResult.DBGridResultDblClick(Sender: TObject);
begin
  BBtnFindClick(Sender);
end;

procedure TFrmSearchResult.DBGridResultKeyUp(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  FillResultData();
end;

procedure TFrmSearchResult.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  TimerFlash.Enabled := False;
  FrmMain.Map1.Layers.ClearSelection;
end;

procedure TFrmSearchResult.DBGridResultMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FillResultData();
end;

procedure TFrmSearchResult.FormCreate(Sender: TObject);
begin
  DBGridResult.Columns.Items[0].FieldName := 'Name';
end;

end.

⌨️ 快捷键说明

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