unitsearchresultbus_way.~pas

来自「在delphi下基于MapX5.0的GIS程序」· ~PAS 代码 · 共 234 行

unit UnitSearchResultBus_Way;

interface

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

type
  TFrmSearchResultBus_Way = class(TForm)
    TimerSearchResult: TTimer;
    TimerFlash: TTimer;
    GBoxInfo: TGroupBox;
    BBtnClose: TBitBtn;
    PanelResultNum: TPanel;
    PanelTitle: TPanel;
    SGrid1: TStringGrid;
    SGrid2: TStringGrid;
    MemoInfo: TMemo;
    TBarZoom: TTrackBar;
    Label3: TLabel;
    BBtnViewInfo: TBitBtn;
    BBtnFind: TBitBtn;
    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 TBarZoomChange(Sender: TObject);
    procedure BBtnFindClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SGrid2DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SGrid2SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure SGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure BBtnViewInfoClick(Sender: TObject);
    procedure SGrid1DblClick(Sender: TObject);
    procedure SGrid2DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSearchResultBus_Way: TFrmSearchResultBus_Way;
  OnShowing: Boolean;
  iNum: Integer=0;
  Col, Row, SGridNum: Integer;

implementation

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

{$R *.dfm}

procedure TFrmSearchResultBus_Way.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 TFrmSearchResultBus_Way.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 TFrmSearchResultBus_Way.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  if Width > 25 then
  begin
    CanClose := False;
    OnShowing := False;
    TimerSearchResult.Enabled := True;
  end;
end;

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

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

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

procedure TFrmSearchResultBus_Way.BBtnFindClick(Sender: TObject);
var
  FindName: String;
begin
  // 定位
  CanChangeZoom := True;
  With FrmMain do
  begin
    if SGridNum = 1 then FindName := BusWay1[Row+1]
    else if Col = 0 then FindName := BusWay2S[Row+1]
            else FindName := BusWay2E[Row+1];
    FoundObj := Map1.Layers['公交线路'].Find.Search(PYConvert(FindName), '');
    if (FoundObj.Findrc Mod 10 = 1) then
    begin
       FeatureFound := True;
       Map1.ZoomTo((TBarZoom.Position+1)*20, FoundObj.CenterX, FoundObj.CenterY);
       Map1.Layers.ClearSelection;
       Map1.Layers['公交线路'].Selection.SelectByPoint(FoundObj.CenterX, FoundObj.CenterY, miSelectionAppend, miSearchResultDefault);
       Map1.Layers['公交线路'].KeyField := 'ID';
       infoFeature := Map1.Layers['公交线路'].Selection.Item[1];
    end
    else begin
           Application.MessageBox('信息不能定位！', '提示', MB_OK);
           FeatureFound := False;
         end;
  end;
end;

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

procedure TFrmSearchResultBus_Way.SGrid1DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  SGrid1.Canvas.Brush.Color := clRed;
end;

procedure TFrmSearchResultBus_Way.SGrid2DrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  SGrid2.Canvas.Brush.Color := clRed;
end;

procedure TFrmSearchResultBus_Way.SGrid2SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  SGridNum := 2;
  Col := ACol;
  Row := ARow;
  MemoInfo.Lines.Add('乘'+BusWay2S[Row+1]);
  MemoInfo.Lines.Add('在'+BusWay2Spot[Row+1]+'下车');
  MemoInfo.Lines.Add('再乘'+BusWay2E[Row+1]+'可以达到');
end;

procedure TFrmSearchResultBus_Way.SGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  SGridNum := 1;
  Row := ARow;
  MemoInfo.Clear;
  MemoInfo.Lines.Add('乘'+BusWay1[Row+1]+'可以直接达到');
end;

procedure TFrmSearchResultBus_Way.BBtnViewInfoClick(Sender: TObject);
begin
// 定位
  BBtnFindClick(Sender);
  if FeatureFound then
  begin
    EditLayer := FrmMain.Map1.Layers['公交线路'];
    InfoLayerName := '公交线路';
    infFormViewType := SEARCH_FEATURE;
    TimerFlash.Enabled := True; 
    FrmComWay.ShowModal;
  end;
end;

procedure TFrmSearchResultBus_Way.SGrid1DblClick(Sender: TObject);
begin
  BBtnFindClick(Sender);
end;

procedure TFrmSearchResultBus_Way.SGrid2DblClick(Sender: TObject);
begin
  BBtnFindClick(Sender);
end;

end.