Difference between revisions of "Windows Programming Tips"
Sekelsenmat (talk | contribs) (New page: This page is dedicated to desktop Windows programming tips. __TOC__ {{Other Interfaces}} ==Code snipets== ===Listing all available drives=== <delphi> program listdevices; {$ifdef fpc...) |
(Added Windows shortcut/.lnk code from forum: http://lazarus.freepascal.org/index.php/topic,13845.msg72867.html#msg72867) |
||
Line 5: | Line 5: | ||
{{Other Interfaces}} | {{Other Interfaces}} | ||
− | ==Code | + | ==Code snippets== |
===Listing all available drives=== | ===Listing all available drives=== | ||
Line 44: | Line 44: | ||
ReadLn(DriveLetter); | ReadLn(DriveLetter); | ||
end. | end. | ||
+ | </delphi> | ||
+ | |||
+ | ===Creating a shortcut (.lnk) file=== | ||
+ | <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> | </delphi> |
Revision as of 10:43, 16 July 2011
This page is dedicated to desktop Windows programming tips.
Other Interfaces
- Lazarus known issues (things that will never be fixed) - A list of interface compatibility issues
- Win32/64 Interface - The Windows API (formerly Win32 API) interface for Windows 95/98/Me/2000/XP/Vista/10, but not CE
- Windows CE Interface - For Pocket PC and Smartphones
- Carbon Interface - The Carbon 32 bit interface for macOS (deprecated; removed from macOS 10.15)
- Cocoa Interface - The Cocoa 64 bit interface for macOS
- Qt Interface - The Qt4 interface for Unixes, macOS, Windows, and Linux-based PDAs
- Qt5 Interface - The Qt5 interface for Unixes, macOS, Windows, and Linux-based PDAs
- GTK1 Interface - The gtk1 interface for Unixes, macOS (X11), Windows
- GTK2 Interface - The gtk2 interface for Unixes, macOS (X11), Windows
- GTK3 Interface - The gtk3 interface for Unixes, macOS (X11), Windows
- fpGUI Interface - Based on the fpGUI library, which is a cross-platform toolkit completely written in Object Pascal
- Custom Drawn Interface - A cross-platform LCL backend written completely in Object Pascal inside Lazarus. The Lazarus interface to Android.
Platform specific Tips
- Android Programming - For Android smartphones and tablets
- iPhone/iPod development - About using Objective Pascal to develop iOS applications
- FreeBSD Programming Tips - FreeBSD programming tips
- Linux Programming Tips - How to execute particular programming tasks in Linux
- macOS Programming Tips - Lazarus tips, useful tools, Unix commands, and more...
- WinCE Programming Tips - Using the telephone API, sending SMSes, and more...
- Windows Programming Tips - Desktop Windows programming tips
Interface Development Articles
- Carbon interface internals - If you want to help improving the Carbon interface
- Windows CE Development Notes - For Pocket PC and Smartphones
- Adding a new interface - How to add a new widget set interface
- LCL Defines - Choosing the right options to recompile LCL
- LCL Internals - Some info about the inner workings of the LCL
- Cocoa Internals - Some info about the inner workings of the Cocoa widgetset
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
<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>