Windows Programming Tips

From Free Pascal wiki
Jump to navigationJump to search

This page is dedicated to desktop Windows programming tips.

Other Interfaces

Platform specific Tips

Interface Development Articles

Articles about Windows Programming

  • High DPI - How to make your application DPI-aware on Windows 7.
  • Aero Glass - How to apply Aero Glass effect in a Lazarus Form on Windows 7.
  • Windows Icon - How to design your icon with the right sizes.
  • Inno Setup Usage - How to create setup files with File Association support.

Code snippets

Listing all available drives

<delphi> program listdevices;

{$ifdef fpc}{$mode delphi}{$endif} {$apptype console}

uses 

 Windows;

var 

 Drive: Char;
 DriveLetter: string;

begin 

 WriteLn('The following drives were found in this computer:');
 WriteLn();

 // Search all drive letters
 for Drive := 'A' to 'Z' do
 begin
   DriveLetter := Drive + ':\';
  
   case GetDriveType(PChar(DriveLetter)) of
    DRIVE_REMOVABLE: WriteLn(DriveLetter + ' Floppy Drive');
    DRIVE_FIXED:     WriteLn(DriveLetter + ' Fixed Drive');
    DRIVE_REMOTE:    WriteLn(DriveLetter + ' Network Drive');
    DRIVE_CDROM:     WriteLn(DriveLetter + ' CD-ROM Drive');
    DRIVE_RAMDISK:   WriteLn(DriveLetter + ' RAM Disk');
   end;
 end;

 // Also add a stop to see the result under Windows
 WriteLn();
 WriteLn('Please press <ENTER> to exit the program.');
 ReadLn(DriveLetter);

end. </delphi>

Creating a shortcut (.lnk) file

Taken from forum post by Lainz: Windows Startup post on forum

<delphi> UNIT shortcut;

INTERFACE 

 uses windows;

 FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean;

 // create a windows shortcut file (*.lnk)@lnkpos.
 // example: createSohrtcut('c:\test.lnk','c:\pascal\myprog.exe','-L 1000','c:\pascal','A nice Program.','c:\pascal\myprog.exe',0);

IMPLEMENTATION

TYPE REFCLSID = PGUID; REFIID = PGUID;

CONST CLSID_ShellLink : TGUID = '{00021401-0000-0000-C000-000000000046}'; IID_IShellLink : TGUID = '{000214EE-0000-0000-C000-000000000046}'; IID_IPersistFile : TGUID = '{0000010b-0000-0000-C000-000000000046}'; CLSCTX_INPROC_SERVER = 1;

FUNCTION CoInitialize(p : pointer) : HRESULT; stdcall; external 'ole32.dll'; FUNCTION CoUninitialize(p : pointer) : HRESULT; stdcall; external 'ole32.dll'; FUNCTION CoCreateInstance(a:REFCLSID; b:pointer; c:DWORD; d:REFIID; e:pointer) : HRESULT; stdcall; external 'ole32.dll';

TYPE PPISHellLink = ^PISHellLink; PISHellLink = ^ISHellLink; ISHellLink = packed record 

 QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
 AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
 Release : FUNCTION(basis : pointer) : Hresult; stdcall;
 GetPath : pointer;
 GetIDList : pointer;
 SetIDList : pointer;
 GetDescription : pointer;
 SetDescription : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
 GetWorkingDirectory : pointer;
 SetWorkingDirectory : FUNCTION(basis : pointer; descr : Pchar) : Hresult; stdcall;
 GetArguments : pointer;
 SetArguments : FUNCTION(basis : pointer; args : Pchar) : Hresult; stdcall;
 GetHotkey : pointer;
 SetHotkey : pointer;
 GetShowCmd : pointer;
 SetShowCmd : pointer;
 GetIconLocation : pointer;
 SetIconLocation : FUNCTION(basis : pointer; iconfile : Pchar; icon : longint) : Hresult; stdcall;
 SetRelativePath : pointer;
 Resolve : pointer;
 SetPath : FUNCTION(basis : pointer; path : Pchar) : Hresult; stdcall;

end;

PPIPersistFile = ^PIPersistFile; PIPersistFile = ^IPersistFile; IPersistFile = packed record 

 QueryInterface : FUNCTION(basis,id,p : pointer) : Hresult; stdcall;
 AddRef : FUNCTION(basis : pointer) : Hresult; stdcall;
 Release : FUNCTION(basis : pointer) : Hresult; stdcall;
 GetClassID : FUNCTION(basis,p : pointer) : Hresult; stdcall;
 IsDirty : FUNCTION(basis : pointer) : Hresult; stdcall;
 Load : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
 Save : FUNCTION(basis : pointer; fn : Pchar; dw : dword) : Hresult; stdcall;
 SaveCompleted : FUNCTION(basis : pointer; fn : Pchar) : Hresult; stdcall;
 GetCurFile : FUNCTION(basis : pointer; fn : PPchar) : Hresult; stdcall;

end;


FUNCTION createShortcut(lnkpos : widestring; dstfn,dstargs,dstwdir,descr,iconfn : AnsiString; iconnum : longint) : boolean; VAR psl : PPISHellLink; psp : PPIPersistFile; BEGIN 

 createShortcut := FALSE;
 if CoCreateInstance(@CLSID_ShellLink,nil,CLSCTX_INPROC_SERVER,@IID_IShellLink,@psl)=0 then begin

// writeln('got IShellLink'); 

   if  (psl^^.setPath(psl,@dstfn[1])=0)
   and (psl^^.SetArguments(psl,@dstargs[1])=0)
   and (psl^^.SetWorkingDirectory(psl,@dstwdir[1])=0)
   and (psl^^.SetDescription(psl,@descr[1])=0)
   and (psl^^.SetIconLocation(psl,@iconfn[1],iconnum)=0)
   and (psl^^.queryInterface(psl,@IID_IPersistFile,@psp)=0) then begin
     if psp^^.save(psp,@lnkpos[1],0)=0 then createShortcut := true;   
     psp^^.release(psp);
   end;
   psl^^.Release(psl);
 end;

END;

BEGIN 

 CoInitialize(nil);

END. </delphi>

Getting special folders (My documents, Desktop, local application data, etc)

Often it is useful to get the location of a special folder such as the desktop. The example below shows how you can get the LocalAppData directory - where the Lazarus installer stores its configuration by default. Look in the shlobj unit for more defines that let you look up the Desktop, Recycle Bin, etc. <delphi> uses ... shlobj;

var 

 AppDataPath: Array[0..MaxPathLen] of Char; //Allocate memory

... begin ... 

   AppDataPath:=;
   SHGetSpecialFolderPath(0,AppDataPath,CSIDL_LOCAL_APPDATA,false);
   writeln('Your local appdata path is: ' + AppDataPath);

</delphi>

Retrieved from "http://wiki.freepascal.org/index.php?title=Windows_Programming_Tips&oldid=54625"