📄 unitcenterfeature.~pas
字号:
unit UnitCenterFeature;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TFrmCenterFeature = class(TForm)
CBoxName: TComboBox;
BBtnOK: TBitBtn;
BBtnCancel: TBitBtn;
TimerInfo: TTimer;
procedure FormShow(Sender: TObject);
procedure TimerInfoTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure BBtnOKClick(Sender: TObject);
procedure BBtnCancelClick(Sender: TObject);
private
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
{ Private declarations }
public
{ Public declarations }
end;
var
FrmCenterFeature: TFrmCenterFeature;
OnShowing: Boolean;
implementation
uses UnitDataModule, UnitSearch, UnitCommonModule;
{$R *.dfm}
// 画窗体边框
procedure TFrmCenterFeature.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 TFrmCenterFeature.FormShow(Sender: TObject);
begin
TimerInfo.Enabled := True;
OnShowing := True;
CBoxName.Clear;
DM.ADOQueryCenterFind.First;
while Not DM.ADOQueryCenterFind.Eof do
begin
CBoxName.Items.Add(DM.ADOQueryCenterFind.FieldByName('Name').AsString);
DM.ADOQueryCenterFind.Next;
end;
CBoxName.ItemIndex := 0;
end;
procedure TFrmCenterFeature.TimerInfoTimer(Sender: TObject);
begin
if OnShowing then
begin
Height := Height + 5;
if Height > 100 then TimerInfo.Enabled := False;
end
else
begin
Height := Height - 5;
if Height < 30 then
begin
TimerInfo.Enabled := False;
Close;
end;
end;
end;
procedure TFrmCenterFeature.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if Height > 30 then
begin
CanClose := False;
OnShowing := False;
TimerInfo.Enabled := True;
end;
end;
procedure TFrmCenterFeature.BBtnOKClick(Sender: TObject);
var
Distance: Integer;
begin
Distance := (FrmSearch.CBoxNearInfDistance.ItemIndex + 1)* 10;
CenterFeatureFind(CBoxName.Text, Distance, FrmSearch.CBoxNearInfType.Text);
end;
procedure TFrmCenterFeature.BBtnCancelClick(Sender: TObject);
begin
Close;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -