关闭开启窗体.txt

dbgrid显示数据库记录时,可以建立ontitle事件使鼠标控制grid滚动

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSkinData, WinSkinStore, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    SkinStore1: TSkinStore;
    SkinData1: TSkinData;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    Label3: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
var
str: string;
cl: HWnd;
begin
str:='pzrdserver.exe';
label3.caption:=formatdatetime('hh:mm:ss',now);
if label3.caption='12:00:00' then
begin
//Cl :=Findwindow(nil,'Calendar_ZhouLei');
Cl :=Findwindow(nil,'小灵通/固定电话系统信息接收程序[版本号:2005-8-13v1.0]');
if cl <> 0 then
begin
 SendMessage(Cl,WM_CLOSE,0,0);
 winexec(PChar(str),SW_SHOWNORMAL);
 label2.caption:='监控窗口安全运行! ';
end
else
  messagedlg('智能平台尚未开启,无需关闭!',mtinformation,[mbok],0);
end;

if label3.caption='12:00:01' then
begin
 if fileexists(str) then
 begin
 //str:='mo3.exe';
  winexec(PChar(str), SW_SHOWNORMAL);
  label2.caption:='监控窗口安全运行! ';
 end
 else
  messagedlg('未发现智能平台运行程序',mtinformation,[mbok],0);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var str: string;
cs: HWnd;
begin
  //cs:=Findwindow(nil,'Calendar_ZhouLei');
  cs :=Findwindow(nil,'小灵通/固定电话系统信息接收程序[版本号:2005-8-13v1.0]');
  if cs=0 then
  begin
   str:='pzrdserver.exe';
   if fileexists(str) then
   begin
    winexec(PChar(str), SW_SHOWNORMAL);
    label2.caption:='监控窗口安全运行! ';
   end
   else
    messagedlg('未发现智能平台运行程序',mtinformation,[mbok],0);
 end;
 end;
end.
//////////


[要把你的程序显示在托盘区：
下面是一个托盘类，只要把下面粘贴到文本文件中，改成TrayIcon.pas，使用时uses TrayIcon就可以了。

先声明一个全局变量：
var tray:TTrayNotifyIcon;

然后在窗体的OnCreate事件中：
tray:=TTrayNotifyIcon.Create(self);//将窗体创建为托盘
tray.Icon:=application.Icon;//定义托盘的显示图标
tray.IconVisible:=true;//托盘可见
tray.PopupMenu:=popmenu;//给托盘定义一个右击时的弹出菜单
tray.OnDblClick:=trayDblClick;//给托盘定义一个双击事件(当然要自己写了，不过多数情况只有一行，就是Form1.show);


unit TrayIcon;

interface

uses Windows, SysUtils, Messages, ShellAPI, Classes, Graphics, Forms, Menus,
StdCtrls, ExtCtrls;

type
ENotifyIconError = class(Exception);

TTrayNotifyIcon = class(TComponent)
private
FDefaultIcon: THandle;
FIcon: TIcon;
FHideTask: Boolean;
FHint: string;
FIconVisible: Boolean;
FPopupMenu: TPopupMenu;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FNoShowClick: Boolean;
FTimer: TTimer;
Tnd: TNotifyIconData;
procedure SetIcon(Value: TIcon);
procedure SetHideTask(Value: Boolean);
procedure SetHint(Value: string);
procedure SetIconVisible(Value: Boolean);
procedure SetPopupMenu(Value: TPopupMenu);
procedure SendTrayMessage(Msg: DWORD; Flags: UINT);
function ActiveIconHandle: THandle;
procedure OnButtonTimer(Sender: TObject);
protected
procedure Loaded; override;
procedure LoadDefaultIcon; virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Icon: TIcon read FIcon write SetIcon;
property HideTask: Boolean read FHideTask write SetHideTask default False;
property Hint: String read FHint write SetHint;
property IconVisible: Boolean read FIconVisible write SetIconVisible default False;
property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
end;

implementation

{ TIconManager }
{ This class creates a hidden window which handles and routes }
{ tray icon messages }
type
TIconManager = class
private
FHWindow: HWnd;
procedure TrayWndProc(var Message: TMessage);
public
constructor Create;
destructor Destroy; override;
property HWindow: HWnd read FHWindow write FHWindow;
end;

var
IconMgr: TIconManager;
DDGM_TRAYICON: Cardinal;

constructor TIconManager.Create;
begin
FHWindow := AllocateHWnd(TrayWndProc);
end;

destructor TIconManager.Destroy;
begin
if FHWindow <> 0 then DeallocateHWnd(FHWindow);
inherited Destroy;
end;

procedure TIconManager.TrayWndProc(var Message: TMessage);
{ This allows us to handle all tray callback messages }
{ from within the context of the component. }
var
Pt: TPoint;
TheIcon: TTrayNotifyIcon;
begin
with Message do
begin
{ if it’s the tray callback message }
if (Msg = DDGM_TRAYICON) then
begin
TheIcon := TTrayNotifyIcon(WParam);
case lParam of
{ enable timer on first mouse down. }
{ OnClick will be fired by OnTimer method, provided }
{ double click has not occurred. }
WM_LBUTTONDOWN: TheIcon.FTimer.Enabled := True;
{ Set no click flag on double click. This will supress }
{ the single click. }
WM_LBUTTONDBLCLK:
begin
TheIcon.FNoShowClick := True;
if Assigned(TheIcon.FOnDblClick) then TheIcon.FOnDblClick(Self);
end;
WM_RBUTTONDOWN:
begin
if Assigned(TheIcon.FPopupMenu) then
begin
{ Call to SetForegroundWindow is required by API }
SetForegroundWindow(IconMgr.HWindow);
{ Popup local menu at the cursor position. }
GetCursorPos(Pt);
TheIcon.FPopupMenu.Popup(Pt.X, Pt.Y);
{ Message post required by API to force task switch }
PostMessage(IconMgr.HWindow, WM_USER, 0, 0);
end;
end;
end;
end
else
{ If it isn’t a tray callback message, then call DefWindowProc }
Result := DefWindowProc(FHWindow, Msg, wParam, lParam);
end;
end;

{ TTrayNotifyIcon }

constructor TTrayNotifyIcon.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIcon := TIcon.Create;
FTimer := TTimer.Create(Self);
with FTimer do
begin
Enabled := False;
Interval := GetDoubleClickTime;
OnTimer := OnButtonTimer;
end;
{ Keep default windows icon handy... }
LoadDefaultIcon;
end;

destructor TTrayNotifyIcon.Destroy;
begin
if FIconVisible then SetIconVisible(False); // destroy icon
FIcon.Free; // free stuff
FTimer.Free;
inherited Destroy;
end;

function TTrayNotifyIcon.ActiveIconHandle: THandle;
{ Returns handle of active icon }
begin
{ If no icon is loaded, then return default icon }
if (FIcon.Handle <> 0) then
Result := FIcon.Handle
else
Result := FDefaultIcon;
end;

procedure TTrayNotifyIcon.LoadDefaultIcon;
{ Loads default window icon to keep it handy. }
{ This will allow the component to use the windows logo }
{ icon as the default when no icon is selected in the }
{ Icon property. }
begin
FDefaultIcon := LoadIcon(0, IDI_WINLOGO);
end;

procedure TTrayNotifyIcon.Loaded;
{ Called after component is loaded from stream }
begin
inherited Loaded;
{ if icon is supposed to be visible, create it. }
if FIconVisible then
SendTrayMessage(NIM_ADD, NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;

procedure TTrayNotifyIcon.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = PopupMenu) then
PopupMenu := nil;
end;

procedure TTrayNotifyIcon.OnButtonTimer(Sender: TObject);
{ Timer used to keep track of time between two clicks of a }
{ double click. This delays the first click long enough to }
{ ensure that a double click hasn’t occurred. The whole }
{ point of these gymnastics is to allow the component to }
{ receive OnClicks and OnDblClicks independently. }
begin
{ Disable timer because we only want it to fire once. }
FTimer.Enabled := False;
{ if double click has not occurred, then fire single click. }
if (not FNoShowClick) and Assigned(FOnClick) then
FOnClick(Self);
FNoShowClick := False; // reset flag
end;

procedure TTrayNotifyIcon.SendTrayMessage(Msg: DWORD; Flags: UINT);
{ This method wraps up the call to the API’s Shell_NotifyIcon }
begin
{ Fill up record with appropriate values }
with Tnd do
begin
cbSize := SizeOf(Tnd);
StrPLCopy(szTip, PChar(FHint), SizeOf(szTip));
uFlags := Flags;
uID := UINT(Self);
Wnd := IconMgr.HWindow;
uCallbackMessage := DDGM_TRAYICON;
hIcon := ActiveIconHandle;
end;
Shell_NotifyIcon(Msg, @Tnd);
end;

procedure TTrayNotifyIcon.SetHideTask(Value: Boolean);
{ Write method for HideTask property }
const
{ Flags to show application normally or hide it }
ShowArray: array[Boolean] of integer = (sw_ShowNormal, sw_Hide);
begin
if FHideTask <> Value then
begin
FHideTask := Value;
{ Don’t do anything in design mode }
if not (csDesigning in ComponentState) then
ShowWindow(Application.Handle, ShowArray[FHideTask]);
end;
end;

procedure TTrayNotifyIcon.SetHint(Value: string);
{ Set method for Hint property }
begin
if FHint <> Value then
begin
FHint := Value;
if FIconVisible then
{ Change hint on icon on tray notification area }
SendTrayMessage(NIM_MODIFY, NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetIcon(Value: TIcon);
{ Write method for Icon property. }
begin
FIcon.Assign(Value); // set new icon
{ Change icon on notification tray }
if FIconVisible then SendTrayMessage(NIM_MODIFY, NIF_ICON);
end;

procedure TTrayNotifyIcon.SetIconVisible(Value: Boolean);
{ Write method for IconVisible property }
const
{ Flags to add or delete a tray notification icon }
MsgArray: array[Boolean] of DWORD = (NIM_DELETE, NIM_ADD);
begin
if FIconVisible <> Value then
begin
FIconVisible := Value;
{ Set icon as appropriate }
SendTrayMessage(MsgArray[Value], NIF_MESSAGE or NIF_ICON or NIF_TIP);
end;
end;

procedure TTrayNotifyIcon.SetPopupMenu(Value: TPopupMenu);
{ Write method for PopupMenu property }
begin
FPopupMenu := Value;
if Value <> nil then Value.FreeNotification(Self);
end;

const
{ String to identify registered window message }
TrayMsgStr = ’DDG.TrayNotifyIconMsg’;

initialization
{ Get a unique windows message ID for tray callback }
DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr);
IconMgr := TIconManager.Create;
finalization
IconMgr.Free;
end.
]

*测试文件是否存在

procedure  TForm1.Button1Click(Sender:Tobject);
 var
    Handle：  THandle；
    FindData：TWin32FindData；
    FileName：TFileName；
begin
    FileName:=Editl.Text；
Handle:=findfirstfile(PChar(filename),finddata);
lf  Handle<>INVALID_HANDLE_VALUE  then 
messageDlg('文件存在。',mtinfomation,[mbok],0)
else
messageDlg('文件不存在。',mtinfomation,[mbok],0);
end;


*查询文件属性
procedure  TForm1.Button1Click(Sender:Tobject);
var
    sr: TSearchRec；
    FileAttrs:Integer;
begin
 stringGrid1.RowCount:=1;
if  CheckBox1.Checked  then
    FileAttrs:=faReadonly
 else
    FileAttrs:=0；
if CheckBox2.Checked  then
  FileAttrs:=FileAttrs+faHidden;
if CheckBox3.Checked  then
  FileAttrs:=FileAttrs+faSysfile;
if CheckBox4.Checked  then
  FileAttrs:=FileAttrs+faVolumeId;
if CheckBox5.Checked  then
  FileAttrs:=FileAttrs+faDirectory;
if CheckBox6.Checked  then
  FileAttrs:=FileAttrs+faArchive;
if CheckBox7.Checked  then
  FileAttrs:=FileAttrs+faAnyFile;

with StringGird1 do
begin
rowcount:=0
If  FindFirst(Edit1.Text,FileAttrs,sr)=0 then
begin
  cells[1,0]:='文件名';
  cells[2,0]:='大件(k)';

repeat
  If (sr.Attr and FileAttrs)=sr.Attr then
  begin
  RowCount:=RowCount+1;
  Cells[1,RowCount-1]:=sr.Name;
  Cells[2,RowCount-1]:=IntToStr(sr.Size);
 end：
    until  FindNext(sr)<>0;
    FindClose(sr);
  end；
 end；
end；


*.打开文件修改为指定后缀名
button 打开文件

if (0penDialogl.Execute)  then
    Edltl.Text:＝0penDialogl.FileName；

button 修改文件后缀名
var str:string;
begin
If(trim(Edit1．Text)<>'') then
begin
  strl:=Copy(Trim(Edit2.text)0,1);
if(strl＝'.') then
    showmessage('修改扩展名后文件如下:'+ChangeFileExt(Edit1.Text,trim(Edit2.Text)))
else
    showmessage('修改扩展名后文件如下:'+ChangeFileExt(Edit1.Text,'.'+trim(Edit2.Text)));
end
end;




*、查询数据库输出
adoquery1.SQL.clear;
dbgrid1.visible:=true;
Adoquery1.SQL.Add('select * from jizh2 where 基站名 like'+#39+'%'+edit1.text+'%'+#39);
Adoquery1.open;
label2.Caption:=adoquery1.FieldByName('小区号').AsString;