Common Use of Delphi

Source: Internet
Author: User

1. Only one instance is allowed to start the program.

VaR
Mutex: thandle;
Begin
Mutex: = createmutex (nil, true, '80a8a422-D84F-4FEA-953F-B08148F60ABD ');
If getlasterror <> error_already_exists then
Begin
Application. initialize;
Application. createform (tfmmonitor, fmmonitor );
Application. Run;
End else
Begin
Releasemutex (mutex );
End;

2. Write logs

Procedure writelog (STR: string );
VaR
F: textfile;
Strfile: string;
Begin
Strfile: = apppath + 'dataex. log ';
{I -}
Assignfile (F, strfile );
If fileexists (strfile) then
Begin
If filesizebyname (strfile)> 1024*50 then
Rewrite (f );
End else
Rewrite (f );
Append (f );
Writeln (F, STR );
Writeln (F ,'');
Closefile (f );
{I +}
End;

3. Minimal after starting the program

Procedure tfmmonitor. formshow (Sender: tobject );
Begin
Postmessage (handle, wm_syscommand, SC _minimize, 0 );
End;

4. multi-thread synchronization

Thread call:
Hmutex: = createmutex (nil, false, nil );
Ftpdothread: = tftpthread. Create (true );
Ftpdothread. Resume;

Thread definition:
Type
Tftpthread = Class (tthread)
Private
Protected
Procedure execute; override;
Destructor destroy; override;
End;

VaR
Ftpdothread: tftpthread;
Hmutex: thandle = 0;

Implementation

Destructor tftpthread. Destroy;
Begin
Ftpdothread: = nil;
Inherited;
End;

Procedure tftpthread. Execute;
Begin
Freeonterminate: = true;
If waitforsingleobject (hmutex, infinite) = wait_object_0 then
Begin
.........
End;
Releasemutex (hmutex );
Terminate;
End;

5. Create a directory
Procedure tfmmonitor. testcreatedir (instr: string );
Begin
If not directoryexists (apppath + instr) then
Begin
{$ I -}
Createdir (apppath + instr );
{$ I +}
End;
End;

6. Get a directory file (excluding subdirectories)

Call: getdirfiles (fmmonitor. apppath + 'upload /*.*');
Function tftpthread. getdirfiles (indirstr: string): tstrings;
VaR
Ifindresult: integer;
Searchrec: tsearchrec;
Filelist: tstrings;
Begin
Filelist: = tstringlist. Create;
Ifindresult: = findfirst (indirstr, faanyfile, searchrec );
While ifindresult = 0 do
Begin
If searchrec. ATTR <> fadirectory then
Filelist. Add (searchrec. Name );
Ifindresult: = findnext (searchrec );
End;
Findclose (searchrec );
Result: = filelist;
End;

7. Replace and repeat Functions
Ansireplacestr
Dupestring

8. prevent screen refreshing
Lockwindowupdate (getmediatopwindow );
Lockwindowupdate (handle );
........
Lockwindowupdate (0 );

9. Execute external programs
ShellExecute (handle, 'open', pchar (extractfilepath (application. exename)
+ 'Readme. chm'), nil, nil, sw_shownormal)

10. shotcut usage of the tapplicationevent component
Procedure tdemoform. apppresskeyshortcut (var msg: twmkey;
VaR handled: Boolean );
Begin
Case msg. charcode
Vk_f7:
Begin
End;
End;
End;

11. Hide the mouse
Showcursor (false );

12. Only uppercase letters are allowed.
Keypress (Sender: tobject; var key: Char );
Begin
If ord (key) in [97 .. 122] Then
Key: = CHR (ord (key)-32 );
End;

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.