unitbybus.pas
来自「在delphi下基于MapX5.0的GIS程序」· PAS 代码 · 共 138 行
PAS
138 行
unit UnitByBus;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TFrmByBus = class(TForm)
CBoxStartStation: TComboBox;
BBtnOK: TBitBtn;
BBtnCancel: TBitBtn;
TimerInfo: TTimer;
LabelStartStation: TLabel;
LabelEndStation: TLabel;
CBoxEndStation: TComboBox;
procedure FormShow(Sender: TObject);
procedure TimerInfoTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure BBtnCancelClick(Sender: TObject);
procedure BBtnOKClick(Sender: TObject);
private
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
{ Private declarations }
public
{ Public declarations }
end;
var
FrmByBus: TFrmByBus;
OnShowing: Boolean;
implementation
uses UnitDataModule, UnitSearch, UnitCommonModule, UnitSearchResultBus_Way,
UnitSearchResult;
{$R *.dfm}
// 画窗体边框
procedure TFrmByBus.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 TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height+5);
if Not TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height);
if Not OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height-5);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;
procedure TFrmByBus.FormShow(Sender: TObject);
begin
TimerInfo.Enabled := True;
OnShowing := True;
// 加载初始站点
CBoxStartStation.Clear;
OpenADOQueryAllL(DM.ADOQueryBus_SpotS, '公交站点', FrmSearch.EditBusSStation.Text);
DM.ADOQueryBus_SpotS.First;
while Not DM.ADOQueryBus_SpotS.Eof do
begin
CBoxStartStation.Items.Add(DM.ADOQueryBus_SpotS.FieldByName('Name').AsString);
DM.ADOQueryBus_SpotS.Next;
end;
CBoxStartStation.ItemIndex := 0;
// 加载终止站点
CBoxEndStation.Clear;
OpenADOQueryAllL(DM.ADOQueryBus_SpotE, '公交站点', FrmSearch.EditBusEStation.Text);
DM.ADOQueryBus_SpotE.First;
while Not DM.ADOQueryBus_SpotE.Eof do
begin
CBoxEndStation.Items.Add(DM.ADOQueryBus_SpotE.FieldByName('Name').AsString);
DM.ADOQueryBus_SpotE.Next;
end;
CBoxEndStation.ItemIndex := 0;
end;
procedure TFrmByBus.TimerInfoTimer(Sender: TObject);
begin
if OnShowing then
begin
Height := Height + 5;
if Height > 125 then TimerInfo.Enabled := False;
end
else
begin
Height := Height - 5;
if Height < 30 then
begin
TimerInfo.Enabled := False;
Close;
end;
end;
end;
procedure TFrmByBus.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if Height > 30 then
begin
CanClose := False;
OnShowing := False;
TimerInfo.Enabled := True;
end;
end;
procedure TFrmByBus.BBtnCancelClick(Sender: TObject);
begin
Close;
end;
procedure TFrmByBus.BBtnOKClick(Sender: TObject);
begin
if CBoxStartStation.Text = CBoxEndStation.Text then
Application.MessageBox('请选择不同的站点', '提示' ,0)
else
begin
FindBus_Way();
FrmSearchResult.Hide;
FrmSearchResultBus_Way.Show;
Close;
end;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?