//修改指定路径下的文件只读属性 function PathSetAttr(sFilePath: string): Boolean; var SearchRec: TSearchRec; begin Result := False; if Copy(sFilePath, Length(sFilePath) - 1, Length(sFilePath)) <> ’\’ then sFilePath := sFilePath + ’\’; if DirectoryExists(sFilePath) then begin if FindFirst(sFilePath+’*.*’, faAnyFile, SearchRec) = 0 then begin FileSetAttr(SearchRec.Name, 32); while FindNext(SearchRec) = 0 do FileSetAttr(SearchRec.Name, 32); end; Result := True; end; end;
1、判断机器是否网络状态 答: uses WinInet; procedure TForm1.Button1Click(Sender: TObject); function GetOnlineStatus : Boolean; var ConTypes : Integer; begin ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; if (InternetGetConnectedState(@ConTypes, 0) = False) then Result := False else Result := True; end; begin if not GetOnlineStatus then ShowMessage(’Not Connected’); end;
liOldIdleTime: LARGE_INTEGER = (); liOldSystemTime: LARGE_INTEGER = (); SysBaseInfo: TSystem_Basic_Information; SysPerfInfo: TSystem_Performance_Information; SysTimeInfo: TSystem_Time_Information; status: Longint; {long} dbSystemTime: Double; dbIdleTime: Double; function GetCPUUsage:Double; implementation function Li2Double(x: LARGE_INTEGER): Double; begin Result := x.HighPart * 4.294967296E9 + x.LowPart end;
function GetCPUUsage:Double; var bLoopAborted : boolean; begin if @NtQuerySystemInformation = nil then NtQuerySystemInformation := GetProcAddress(GetModuleHandle(‘ntdll.dll‘), ‘NtQuerySystemInformation‘); // get number of processors in the system status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil); if status <> 0 then Exit; // Show some information {with SysBaseInfo do begin ShowMessage( Format(‘uKeMaximumIncrement: %d‘#13‘uPageSize: %d‘#13+ ‘uMmNumberOfPhysicalPages: %d‘+#13+‘uMmLowestPhysicalPage: %d‘+#13+ ‘uMmHighestPhysicalPage: %d‘+#13+‘uAllocationGranularity: %d‘#13+ ‘uKeActiveProcessors: %d‘#13‘bKeNumberProcessors: %d‘, [uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages, uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity, uKeActiveProcessors, bKeNumberProcessors])); end; } bLoopAborted := False; while not bLoopAborted do begin // get new system time status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0); if status <> 0 then Exit; // get new CPU‘s idle time status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil); if status <> 0 then Exit; // if it‘s a first call - skip it if (liOldIdleTime.QuadPart <> 0) then begin // Currentvalue = Newvalue - Oldvalue dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime); dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime); // CurrentCpuIdle = IdleTime / SystemTime dbIdleTime := dbIdleTime / dbSystemTime; // CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5; // Show Percentage //Form1.Label1.Caption := FormatFloat(‘CPU Usage: 0.0 %‘,dbIdleTime); //Application.ProcessMessages; // Abort if user pressed ESC or Application is terminated Result:=dbIdleTime; bLoopAborted:=True; //bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated; end; // store new CPU‘s idle and
=========================================
4、动态生成控件? 答: var TeSpeedButtonX:TTeSpeedButton; begin TeSpeedButtonX:=TTeSpeedButton.Create(nil); TeSpeedButtonX.Caption:=’标题’; TeSpeedButtonX.Name:=’按钮’+inttostr(X); TeSpeedButtonX.Parent:=Tetoolbar2; X:=X+1; end;
=========================================
5、我动态创建了多个button,使用时,我怎么判断出用户点击的是哪个button呢?button的各项属性都边成最后创建的那个button的了,怎么办哦? 答1: 教你一招,先设置每个button的tag属性.然后在onclick事件中用(sender as button).tag来判断,相信我,没错的!
3、我想先->闪现窗体->主窗体->登录窗体,工程源文件怎么设置? 答: ⒈开始一个新工程。给表格起名为MainForm,MainForm的单元起名为Main, 工程文 件起名为Test。 ⒉在MainForm中插入一个Button部件,将其Caption属性设为“关闭”,为该部件 的onClick事件创建一个过程,并在过程的begin和end之间插入Close语句。 ⒊在应用程序添加一个表格,将这个表格起名为MoveForm,MoveForm 的单元起名 为Move。 ⒋为便于演示,在MoveForm中插入一个Label部件,设置其Caption 属性为“欢迎 进入本系统”。 5.下一步修改工程的源代码。选择View/Project Source,修改begin和end之间的 语句如下: 程序清单Test.Dpr program Test uses forms, Main in ’MAIN.PAS’{MainForm}, Move in ’Move.PAS’{MoveForm}
{$R *.RES}
begin MoveForm:=TMoveForm.Create(Application);{Create创建闪现窗口对象} MoveForm.Show; MoveForm.Update; Application.CreateForm(TMainForm,MainForm); MoveForm.Hide; MoveForm.Free;{Free从内存中释放对象} Application.Run; end. 第一条语句创建了对象,该对象存在内存中,但还不能看见, 为了让它出现并更 新它的内容,调用对象的Show和Update成员函数:Show和Update。 当闪现窗口使 用完后,用Hide函数将它隐藏起来,然后用Free函数释放它所占据的内存。 6.如果此刻你编译和运行程序,MoveForm窗口一闪而过, 你可能未来得及看 清。为使MoveForm窗口显示几秒种,我们可为MainForm的OnCreate 事件创建一个 处理程序,延迟MoveForm窗口的显现时间。 program TMainForm.FormCreate(sender:Tobject); var currentTime:LongInt; begin currentTime:=GetTickCount div 1000; while ((GetTickCount div 1000)<(currentTime+3) do {不做任何事); end; end. GetTickCount函数返回窗口启动后过去的毫秒数,这个值除以1000 转化为秒数。 此时你编译运行程序,就能得到一个延迟3秒多的闪现窗口。 为闪现窗口添加上Image部件,再对字体及窗口进行修饰,我们就能为应用程 序,创建一个精美的封面或在程序启动时显示重要提示。
树节点全部展开: procedure TForm1.Button1Click(Sender: TObject); var node:TTreeNode; begin if treeview1.Items[0]<>nil then begin node:=treeview1.Items[0]; node.Expand(true); while node.getNextSibling<>nil do begin node:=node.getNextSibling; node.Expand(true); end; end; end;
树节点全部收缩: procedure TForm1.Button2Click(Sender: TObject); var node:TTreeNode; begin if treeview1.Items[0]<>nil then begin node:=treeview1.Items[0]; node.Collapse(true); while node.getNextSibling<>nil do begin node:=node.getNextSibling; node.Collapse(true); end; end; end;
================================
7、如何用delphi编程实现给access数据库加密码? 答:1,新建Project。 2,在FORM中放入ADOConnection控件。 3,双击ADOConnection控件,然后点击Build...按钮,在“提供者”页中选择“Microsoft Jet 4.0 OLE DB Provider”,然后点击“下一步”按钮,在“连接”页中选择要连接的Access数据库的路径和数据库的文件名,这时如果点“测试连接”按钮时,出现“初始化提供者时发生错误,测试连接失败,密码无效”的错误提示。 4,这时点“所有”页,然后双击“Jet OLEDB:Database Password”,出现对话框,添入密码后,选择“连接”页中的“测试连接”按钮,出现“测试连接成功”的对话框。把ADOConnection控件的LoginPromtp设为false. 5,设置连接完成。
================================
8、如何判断Treeview中我选中的节点是否有子节点?如果没有给出提示啊? 答: if Treeview.Selected.HasChildren then //有 else //无
var Node :TTreeNode; begin Node :=TreeView1.Selected; if Node.HasChildren then .... 对复杂的程序最好用Node过渡
11、我在form1上有四个edit,输完后我想用下上箭头键进行上移下移?怎么办? 答: procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key=vk_down then perform(WM_NEXTDLGCTL,0,0) else if key=vk_up then perform(WM_NEXTDLGCTL,1,0); end;
================================
12、如何用delphi5实现读文本文件指定的一行,并得到文本文件的总行数?谢谢! 答: Delphi读文件文件一般使用Readln过程,如要读第3行可以这样: var i : Integer; F: TextFile; S: string; begin if OpenDialog1.Execute then { Display Open dialog box } begin AssignFile(F, OpenDialog1.FileName); { File selected in dialog } Reset(F); For i = 1 To 3 Do Readln(F, S); Edit1.Text := S; { Put string in a TEdit control } CloseFile(F); . end; 要统计总行数,只能从头逐行读,直到文件尾(Eof函数为True),每读一行计数器加1。 不过由于文本文件的每行长度不相等,它不能象数据库文件那样想读那行就读哪行,只能顺序读。 上面的方法容易理解,也容易实现。如果希望提高速度,编程上要麻烦一些,可以以二进制方式打开文件,将所有内容读入一个内存变量,然后使用Pos函数查找其中的回车(#13)个数,这样可以快速地统计总行数并能快速地找到指定行。
15、在主窗口中打开另一个独立的窗口,而这个被打开的窗口固定显示在..? 答: procedure TForm2.FormCreate(Sender: TObject); begin form2.Hide; self.Parent:=form1.Panel1; end;
================================
16、SaveDialog1确认文件存不存在的办法? 答: procedure TForm1.SaveDialog1CanClose(Sender: TObject; var CanClose: Boolean); begin if FileExists(SaveDialog1.FileName) then //如果文件已经存在 if MessageDlg(’文件已经存在,保存吗?’, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Button2.Click ; //如果选择了覆盖,则退出,否则,重新让用户选择文件 end;
23、我想在bitbtn上设快捷按钮Esc,怎么办? 答: procedure TForm1.BitBtn1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key=27 then application.Terminate; end;
{ 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;
initialization { Get a unique windows message ID for tray callback } DDGM_TRAYICON := RegisterWindowMessage(TrayMsgStr); IconMgr := TIconManager.Create; finalization IconMgr.Free; end.
================================
25、关于窗体释放的问题(formX.free)? 答: 这个我知道,模式窗口用:form2 := TForm2.Create(Application); try if form2.showModal = mrOK then {do Something} finally form2.free; form2 := nil; end; 非模式窗口用:if not Assigned(form2) then form2 := Tfrom2.Create(Application); form2.show;