📄 unitsearchresult.~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 + -