{
To programmatically close another application,
send to the application a WM_QUIT message.
"Window caption" is the caption of the
window that you are sending the message to.
}

function KillApp(const sCapt: PChar) : boolean;
 var AppHandle:THandle;
begin
 AppHandle:=FindWindow(Nil, sCapt);
 Result:=PostMessage(AppHandle, WM_QUIT, 0, 0);
end;

{Usage:}
if not KillApp('Window caption') then
 ShowMessage('App not closed');

{
Given a font's name (such as Arial,
Verdana, Times New Roman, etc), function
returns a boolean value meaning
if the font is or isn't a True Type font. 
}

function IsTrueTypeFont(FontName : string):boolean;
const
 PITCH_MASK: byte = $0F;
var
 TxMet: TTextMetric;
 TempCanvas : TCanvas;
 PitchTest : byte;
begin
 TempCanvas:=TCanvas.Create;
 TempCanvas.Handle:=CreateCompatibleDC(0);
 TempCanvas.Font.Name:=FontName;
 GetTextMetrics(TempCanvas.Handle, TxMet);
 PitchTest:=TxMet.tmPitchAndFamily and PITCH_MASK;
 Result:=(PitchTest and TMPF_TRUETYPE) <> 0;
 TempCanvas.free;
end;

{
If you wish to disable those keys while your
application is running call SystemKeys:
When you call SystemKeys, if Disable is True,
the keys will be disabled, False otherwise.
}
	
procedure SystemKeys(Disable: Boolean);
 var OldVal : LongInt;
begin
 SystemParametersInfo(SPI_SCREENSAVERRUNNING, 
                      Word(Disable), @OldVal, 0);
end;

{A quick way to hide your program's title bar:}
	
procedure TForm1.FormCreate(Sender: TObject);
begin
  SetWindowLong( Handle,
    GWL_STYLE,
    GetWindowLong( Handle, GWL_STYLE )
    and not WS_CAPTION );
  ClientHeight := Height;
end;

Change the font in Tool Tip (Hint box)}

Type
 TMyHintWindow = Class (THintWindow)
  Constructor Create (AOwner: TComponent);override;
 end;

Constructor TMyHintWindow.Create(AOwner:TComponent); 
begin
 Inherited Create (AOwner);
 Canvas.Font.Name := 'Courier New';
 Canvas.Font.Size := 72;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Application.ShowHint := false;
 HintWindowClass := TMyHintWindow;
 Application.ShowHint := True;
end;

{
By default, Delphi gets its date/time, currency
and numeric format from Control Panel's
International settings.

We can set the constants defined in Delphi,
like DecimalSeparator, ShortDateFormat
and others like:
}

procedure SetLocale;
begin
 DecimalSeparator := '.';
 ThousandSeparator : = ','; 
 ShortDateFormat := 'mm/dd/yy';
end;

{
To a complete list of these variables, look at
Currency and date/time formatting variables
in Delphi Help 
}

{
Flashing a window means changing the appearance
of its caption bar as if the window were changing
from inactive to active status, or vice versa.

Typically, a window is flashed to inform the user
that the window requires attention but that it
does not currently have the keyboard focus.

The FlashWindow API function flashes
the window only once.

To create a flashing window add a TTimer component
on a form, and use the following code in the
OnTimer event handler:
}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FlashWindow (Handle, True);
end;

{To OPEN the CD-ROM:}
mciSendString
  ('Set cdaudio door open wait', nil, 0, handle); 

{To CLOSE the CD-ROM:}
mciSendString
  ('Set cdaudio door closed wait', nil, 0, handle); 

{Remember to include the MMSystem
unit in your uses clause.}

uses ShellAPI;
Function DelTree(DirName : string): Boolean;
{
Completely deletes a directory regardless
of whether the directory is filled or has
subdirectories.  No confirmation is requested
so be careful. If the operation is successful
then True is returned, False otherwise
}
var
 SHFileOpStruct : TSHFileOpStruct;
 DirBuf         : array [0..255] of char;
begin
 try
  Fillchar(SHFileOpStruct,Sizeof(SHFileOpStruct),0);
  FillChar(DirBuf, Sizeof(DirBuf), 0 );
  StrPCopy(DirBuf, DirName);
  with SHFileOpStruct do begin
   Wnd    := 0;
   pFrom  := @DirBuf;
   wFunc  := FO_DELETE;
   fFlags := FOF_ALLOWUNDO;
   fFlags := fFlags or FOF_NOCONFIRMATION;
   fFlags := fFlags or FOF_SILENT;
  end; 
   Result := (SHFileOperation(SHFileOpStruct) = 0);
  except
   Result := False;
 end;
end;

{
Usage

if DelTree('c:\TempDir') then
  ShowMessage('Directory deleted!')
else
  ShowMessage('Errors occured!');
}

unit LFN_ALT;
interface
{
This unit provides two functions that convert
filenames from the long format to the 8.3
format, and from the 8.3 format to the long
format.
}
function AlternateToLFN(AltName:String):String;
function LFNToAlternate(LongName:String):String;

implementation

uses Windows;

function AlternateToLFN(AltName:String):String;
var 
 temp: TWIN32FindData;
 searchHandle: THandle;
begin
 searchHandle:=FindFirstFile(PChar(AltName),temp);
 if searchHandle <> ERROR_INVALID_HANDLE then
   result := String(temp.cFileName)
 else
   result := '';
 Windows.FindClose(searchHandle);
end;

function LFNToAlternate(LongName:String):String;
var 
 temp: TWIN32FindData;
 searchHandle: THandle;
begin
 searchHandle:=FindFirstFile(PChar(LongName),temp);
 if searchHandle <> ERROR_INVALID_HANDLE then
   result := String(temp.cALternateFileName)
 else
   result := '';
 Windows.FindClose(searchHandle);
end;
end.{unit}

function FileLastModified
  (const TheFile: string): string;
var
 FileH            : THandle;
 LocalFT          : TFileTime;
 DosFT            : DWORD;
 LastAccessedTime : TDateTime;
 FindData         : TWin32FindData;
begin
 Result := '';
 FileH := FindFirstFile(PChar(TheFile), FindData);
 if FileH <> INVALID_HANDLE_VALUE then begin
  Windows.FindClose(Handle);
  if (FindData.dwFileAttributes AND
      FILE_ATTRIBUTE_DIRECTORY) = 0 then
   begin
    FileTimeToLocalFileTime
     (FindData.ftLastWriteTime,LocalFT);
    FileTimeToDosDateTime
     (LocalFT,LongRec(DosFT).Hi,LongRec(DosFT).Lo);
    LastAccessedTime := FileDateToDateTime(DosFT);
    Result := DateTimeToStr(LastAccessedTime);
   end;
 end;
end;
{
Usage:
label1.Caption:=FileLastModified('c:\autoexec.bat');
}

procedure FindAll (const Path: String;
                         Attr: Integer;
                         List: TStrings);
var
  Res: TSearchRec;
  EOFound: Boolean;
begin
  EOFound:= False;
  if FindFirst(Path, Attr, Res) < 0 then
    exit
  else
    while not EOFound do begin
      List.Add(Res.Name);
      EOFound:= FindNext(Res) <> 0;
    end;
  FindClose(Res);
end; 

{
The following example lists all files and
subdirectories of the C:\Windows directory
into a TListBox called ListBox1:

FindAll('C:\Windows\*.*',faAnyFile,ListBox1.Items);
}

LeftStr() takes a certain portion of
the left side of a string.
. MidStr() takes a specified number of
characters from a string.
. RightStr() takes a certain portion of
the right side of a string.
}

function RightStr
   (Const Str: String; Size: Word): String;
begin
 if Size > Length(Str) then Size := Length(Str);
 RightStr := Copy(Str, Length(Str)-Size+1, Size)
end;

function MidStr
   (Const Str: String; From, Size: Word): String;
begin
 MidStr := Copy(Str, From, Size)
end;

function LeftStr
   (Const Str: String; Size: Word): String;
begin
 LeftStr := Copy(Str, 1, Size)
end;

{
Let's say we have a string
Dstr := 'Delphi is the BEST', then

LeftStr(Dstr, 5) := 'Delph'
MidStr(Dstr, 6, 7) := 'i is th'
RightStr(Dstr, 6) := 'e BEST'
}

function SearchAndReplace
  (sSrc, sLookFor, sReplaceWith : string) : string;
var
  nPos, nLenLookFor : integer;
begin
  nPos        := Pos(sLookFor, sSrc);
  nLenLookFor := Length(sLookFor);
  while (nPos > 0) do begin
    Delete(sSrc, nPos, nLenLookFor);
    Insert(sReplaceWith, sSrc, nPos);
    nPos := Pos(sLookFor, sSrc);
  end;
  Result := sSrc;
end;

{
Let's say you have a string
'testing;search;and;replace'
and you want to replace ';' with spaces.
Here's how you'd call this function

sOldString:='testing;search;and;replace';
sNewString:=SearchAndReplace(sOldString, ';', ' ')
}

{
Tip submitted by: Andrew Burt, [email protected]
}
procedure TForm1.Button1Click(Sender: TObject);
var
 GetString : string;
 GetLength : Integer;
 I         : Integer;
 T         : String;
begin
 if edit1.SelLength > 0 then
   GetString:= Edit1.Seltext
 else GetString:= Edit1.Text;
 GetLength:= Length(Edit1.Text);
 if GetLength>0 then begin
  for I:= 0 to GetLength do begin
   if (GetString[I] = ' ') or (I=0) then begin
    if GetString[I+1] in ['a'..'z'] then begin
     T:=GetString[I+1];
     T:=UpperCase(T);
     GetString[I+1]:=T[1];
    end;
   end;
  end;
  if edit1.Sellength>0 then
    Edit1.Seltext:=GetString
  else Edit1.Text:=GetString;
 end;
end;

Here is an example of creating a
font that is rotated 45 degrees
}

procedure TForm1.Button1Click(Sender: TObject);
var
  lf : TLogFont;
  tf : TFont;
begin
  with Form1.Canvas do begin
    Font.Name := 'Arial';
    Font.Size := 24;
    tf := TFont.Create;
    try
      tf.Assign(Font);
      GetObject(tf.Handle, sizeof(lf), @lf);
      lf.lfEscapement := 450;
      lf.lfOrientation := 450;
      tf.Handle := CreateFontIndirect(lf);
      Font.Assign(tf);
    finally
      tf.Free;
    end;
    TextOut(20, Height div 2, 'Rotated Text!');
  end;
end;

{
IsFileInUse will return true if the file is
locked for exclusive access. It would fail if the
file doesn't exist at all.
}

function IsFileInUse(fName : string) : boolean;
var
   HFileRes : HFILE;
begin
   Result := false;
   if not FileExists(fName) then exit;
   HFileRes :=
     CreateFile(pchar(fName),
                GENERIC_READ or GENERIC_WRITE,
                0, nil, OPEN_EXISTING,
                FILE_ATTRIBUTE_NORMAL,
                0);
   Result := (HFileRes = INVALID_HANDLE_VALUE);
   if not Result then
   CloseHandle(HFileRes);
end;

...
public
  procedure WMSysCommand
    (var Msg: TWMSysCommand);
	message WM_SYSCOMMAND;
...

implementation
...
procedure TForm1.WMSysCommand;
begin
  if (Msg.CmdType = SC_MINIMIZE) or
     (Msg.CmdType = SC_MAXIMIZE) then
  MessageBeep(0);
  
  DefaultHandler(Msg);
end;

{Add a button to a form and try this:}

//Due to the default Windows handling of
//the WM_GETMINMAXINFO message,
//the max size of the form is set to
//the screen size. 

...
private
  procedure WMGetMinMaxInfo
    (var msg: TWMGetMinMaxInfo);
    message WM_GETMINMAXINFO;
...

implementation
procedure TForm1.WMGetMinMaxInfo
    (var msg: TWMGetMinMaxInfo);
begin
  inherited;
  with msg.MinMaxInfo^.ptMaxTrackSize do begin
    X := GetDeviceCaps(Canvas.Handle, HORZRES)
	     + (Width - ClientWidth);
    Y := GetDeviceCaps(Canvas.Handle, VERTRES)
	     + (Height - ClientHeight);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
Const
 Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0);
begin
if Left > 0 then begin
  Rect := BoundsRect;
  SetBounds(
    Left - ClientOrigin.X,
    Top - ClientOrigin.Y,
    GetDeviceCaps(Canvas.Handle, HORZRES)
              + (Width - ClientWidth),
    GetDeviceCaps(Canvas.Handle, VERTRES)
                 + (Height - ClientHeight)
  );
end
else BoundsRect := Rect;
end;

Here is how to keep the window from moving:

First, make the borderstyle something
like bsDialog, so that the window cant be resized.

Next, add the following declaration
to your form class:
}
procedure PosChange(var Msg: TWmWindowPosChanging);
  message WM_WINDOWPOSCHANGING;

//Finally, implement the procedure like:

procedure TForm1.PosChange
  (var Msg: TWmWindowPosChanging);
begin
   Msg.WindowPos.x := Left;
   Msg.WindowPos.y := Top;
   Msg.Result := 0;
end;

{
Thats it. Easy as can be. The only problem with
this is that you cant move the form if you want
your code to. To get around this, just set up a
Boolean variable called PosLocked, set it to
True when you want to lock the forms position,
and to false when you need to move the form (when
your done, remember to set it back to true). Then
to implement the proc above, just make it
}

if PosLocked then begin
   Msg.WindowPos.x := Left;
   Msg.WindowPos.y := Top;
   Msg.Result := 0;
end else inherited;

{
The following example demonstrates using DDE to
execute Explorer's find file dialog. The example
opens the dialog in the Directory "C:\DelphiTips".
}

uses ddeman;
procedure TForm1.Button1Click(Sender: TObject);
begin
 with TDDEClientConv.Create(Self) do begin
  ConnectMode := ddeManual;
  ServiceApplication := 'explorer.exe';
  SetLink( 'Folders', 'AppProperties');
  OpenLink;
  ExecuteMacro
      ('[FindFolder(, C:\DelphiTips)]', False);
  CloseLink;
  Free;
 end;
end;

{
Delete a file with the ability to undo by
sending the file to the "Recycle Bin."

Function FileDeleteRB will return True
if the operation was successful. 
}

uses ShellAPI;

function FileDeleteRB(
  FileName:string): boolean;
var
  fos : TSHFileOpStruct;
begin
  FillChar(fos, SizeOf(fos), 0);
  with fos do begin
    wFunc  := FO_DELETE;
    pFrom  := PChar(FileName);
    fFlags := FOF_ALLOWUNDO
              or FOF_NOCONFIRMATION
              or FOF_SILENT;
  end;
  Result := (ShFileOperation(fos)=0);
end;

{
If you would like to add documents to the new
"Start-Documents" menu that was added with the
creation of Windows 95/NT, use the following
function. Be sure to add ShellAPI and ShlOBJ
to your uses clause. 
}

procedure AddtoDocMenu(fName : String);
begin
  SHAddToRecentDocs(SHARD_PATH, PChar(fName));
end;

{Add a button to a form and try this:}

procedure TForm1.FormCreate(Sender: TObject);
var
  FullRgn, ClientRgn, ButtonRgn: THandle;
  Margin, X, Y: Integer;
begin
  Margin := (Width - ClientWidth) div 2;
  FullRgn := CreateRectRgn(0, 0, Width, Height);
  X := Margin;
  Y := Height - ClientHeight - Margin;
  ClientRgn := CreateRectRgn
    (X, Y, X + ClientWidth, Y + ClientHeight);
  CombineRgn(FullRgn, FullRgn, ClientRgn, RGN_DIFF);
  X := X + Button1.Left;
  Y := Y + Button1.Top;
  ButtonRgn := CreateRectRgn
    (X, Y, X + Button1.Width, Y + Button1.Height);
  CombineRgn(FullRgn, FullRgn, ButtonRgn, RGN_OR);
  SetWindowRgn(Handle, FullRgn, True);
end;

When users enter data, they often need to format it
in a standard way. You can't depend on the user to
do it, so the best bet is to make your program do
the formatting itself.

For example, if the user types a name in all
lowercase letters, the program could automatically
convert the first character in the first and last
names to uppercase letters.

Add the following code to the OnKeyPress event for
the Edit1 component: 
}

with Sender as TEdit do
   if (SelStart = 0) or 
      (Text[SelStart] = ' ') then
         if Key in ['a'..'z'] then 
            Key := UpCase(Key);

//Submited by Joe Ebbeler
{
Many times you may want to select a block of code
in the Delphi editor by column rather than line.
e.g.. You just removed a loop of some kind and you
want to shift a big block of text over 2 spaces.
You can do this by pressing Ctrl + O + C then use
the arrow keys to select the number of characters
then the number of rows. Then press the delete key
or copy or cut. To go back to regular select mode
you can press Ctrl + O + L or you can click
anywhere with the mouse.
}

The table component's ACTIVE property
must be set to FALSE.
Then, put this code on the form's create event:
}
Session.AddPassword('My secret password');
TableName.Active := True;

//Enable:
EnableWindow(FindWindowEx(FindWindow
  ('Shell_TrayWnd', nil), 0,'Button',nil),TRUE);
//Disable:
EnableWindow(FindWindowEx(FindWindow
  ('Shell_TrayWnd', nil), 0,'Button',nil),FALSE);

{
If you want to check whether IDE is runing or not
try this function: (Supose you want your new
shareware component to work only when IDE is
running, or something like that)
}
Function RunningInTheIDE: boolean;
Begin
  Result:=FindWindow('TAppBuilder', nil) > 0;
End;

{
It's a good idea to turn on hint and warning
messages specially when writing and compiling
your own code. Although some of these hints and
warnings can be ignored, most of them - if
nothing else - will remind you of things you
could do to improve your code.

- Go to "Project | Options" 
- Change to the "Compiler" tab 
- Make sure "Show hints" and "Show warnings"
check boxes are checked
}

//To hide the task bar use 
ShowWindow(FindWindow
   ('Shell_TrayWnd',nil), SW_HIDE);

//To show the task bar use 
ShowWindow(FindWindow
   ('Shell_TrayWnd',nil), SW_SHOWNA);

Procedure IcoToBmp;
var
  Icon   : TIcon;
  Bitmap : TBitmap;
begin
  Icon   := TIcon.Create;
  Bitmap := TBitmap.Create;
  Icon.LoadFromFile('c:\picture.ico');
  Bitmap.Width := Icon.Width;
  Bitmap.Height := Icon.Height;
  Bitmap.Canvas.Draw(0, 0, Icon );
  Bitmap.SaveToFile('c:\picture.bmp');
  Icon.Free;
  Bitmap.Free;
end;

//How to disable deleting
//records with keyboard in DBGrid

procedure Form1.DBGrid1KeyDown
  (Sender: TObject; var Key: Word; Shift:TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = VK_DELETE) then
    Key := 0; {ignore}
end;

{
How can I extract the associated icon and draw 
it into a small area of the form (e.g. Notepad icon)?
}
procedure TForm1.Button1Click(Sender: TObject);
var
  IconIndex : word;
  h : hIcon;
begin
 IconIndex := 0;
 h:=ExtractAssociatedIcon
    (hInstance,'C:\WINDOWS\NOTEPAD.EXE', IconIndex);
 DrawIcon(Form1.Canvas.Handle, 10, 10, h);
end;

//Note: you will need one button and
//one memo on your form, for this tip...
procedure TForm1.Button1Click(Sender: TObject);
var
 Drive: Char;
 DriveLetter: String[4];
begin
 for Drive := 'A' to 'Z' do
 begin
  DriveLetter := Drive + ':\';
  case GetDriveType(PChar(Drive + ':\')) of
   DRIVE_REMOVABLE:
    Memo1.Lines.Add(DriveLetter + ' Floppy Drive');
   DRIVE_FIXED:
    Memo1.Lines.Add(DriveLetter + ' Fixed Drive');
   DRIVE_REMOTE:
    Memo1.Lines.Add(DriveLetter + ' Network Drive');
   DRIVE_CDROM:
    Memo1.Lines.Add(DriveLetter + ' CD-ROM Drive');
   DRIVE_RAMDISK:
    Memo1.Lines.Add(DriveLetter + ' RAM Disk');
   end;
 end;
end;

procedure ScreenShot(DestBitmap : TBitmap);
var
  DC : HDC;
begin
 DC := GetDC (GetDesktopWindow);
 try
  DestBitmap.Width  := GetDeviceCaps (DC, HORZRES);
  DestBitmap.Height := GetDeviceCaps (DC, VERTRES);
  BitBlt(DestBitmap.Canvas.Handle,
         0,
         0,
         DestBitmap.Width,
         DestBitmap.Height,
         DC,
         0,
         0,
         SRCCOPY);
 finally
  ReleaseDC (GetDesktopWindow, DC);
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE,
    getWindowLong(Application.Handle, GWL_EXSTYLE) or
    WS_EX_TOOLWINDOW );
  ShowWindow( Application.Handle, SW_SHOW );
end;

{
If you see the Microsoft Plus! you should notice
the "Show window contents while dragging", you
can use this option from your program by calling
the API function: SystemParametersInfo
}
//To Show window contents while dragging:
SystemParametersInfo
    (SPI_SETDRAGFULLWINDOWS, 1, nil, 0);

//To disable this option call the function:
SystemParametersInfo
    (SPI_SETDRAGFULLWINDOWS, 0, nil, 0);

{
When determining which events of a form to define
to do what you want, it's good to know the life
cycle of a form.
}
ACTION
Create
Show
Paint
Activate
ReSize
Paint
Close query
Close
Deactivate
Hide
Destroy

EVENT
OnCreate
OnShow
OnPaint
OnActivate
OnResize
OnPaint
OnCloseQuery
OnClose
OnDeactivate
OnHide
OnDestroy

{
For example, if I change my cursor to a waiting
clock cursor before some time-consuming operations
is executed, why isn't my waiting clock cursor
activated immediately? It's only activated after
the event! This peace of code will update cursor
immediately.
}
begin
  Try
    Screen.Cursor:=crHourGlass;
    MyDataForm := TMyDataForm.Create(Application);
    Screen.Cursor:=crDefault;
    MyDataForm.ShowModal;
    MyDataForm.Free;
  Finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  //Obviously we need our Resource Stream
  RS : TResourceStream;
  //Also we need a File stream to write to disk with
  FS : TFileStream;
begin
  //Open our resource
  RS := TResourceStream.Create(HInstance,'Clouds',RT_RCDATA);
  //Create our file
  FS := TFileStream.Create('c:\newfile.bmp', fmCreate);
  try
    //Copy from Resource to Disk
    FS.CopyFrom(RS,RS.Size);
  finally
    FS.Free;
    RS.Free;
  end;
end;

procedure TForm1.Edit1KeyPress 
(Sender: TObject; var Key: Char);
begin
If Key = #13 Then Begin
 If HiWord(GetKeyState(VK_SHIFT)) <> 0 then
  SelectNext(Sender as TWinControl,False,True)
 else
  SelectNext(Sender as TWinControl,True,True);
  Key := #0
end;
end;

procedure TForm1.DBGrid1KeyPress 
 (Sender: TObject; var Key: Char);
begin
If Key = #13 Then Begin
 If HiWord(GetKeyState(VK_SHIFT)) <> 0 then begin
  with (Sender as TDBGrid) do
  if selectedindex > 0 then
   selectedindex := selectedindex - 1
  else begin
   DataSource.DataSet.Prior;
   selectedindex := fieldcount - 1;
  end;
 end else begin
  with (Sender as TDBGrid) do
  if selectedindex < (fieldcount - 1) then
   selectedindex := selectedindex + 1
  else begin
   DataSource.DataSet.Next;
   selectedindex := 0;
  end;
end;
Key := #0
end;
end