TShellExecuteInfo

In keeping with the posting of old sample snippets in my projects folder; ShellExecuteEx can be used to perform an action such as edit, print, open or properties display on a file. A ShellExecuteInfo structure is passed to the ShellExecuteEx function. A sample of how to display a file's properties dialog is as follows:



uses
ShellAPI;
procedure MyShellExecuteInfo(const filename: string; iVerb: integer);
var
sei: TShellExecuteInfo;
Buffer: array[0..MAX_PATH] of Char;
begin
FillChar(sei,sizeof(sei),0);
sei.cbSize:= sizeof(sei);
sei.lpFile:= PAnsiChar(filename);
// sei.lpDirectory and sei.lpIDList
Case iVerb of
0: sei.lpVerb:= 'properties';
1: sei.lpVerb:= 'open';
2: sei.lpVerb:= 'edit';
3: sei.lpVerb:= 'explore';
4: sei.lpVerb:= 'print';
end;
sei.fMask:= SEE_MASK_INVOKEIDLIST;
sei.nShow:= SW_SHOWNORMAL;
ShellExecuteEx(@sei);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
MyShellExecuteInfo(FileEdit1.Text,RadioGroup1.ItemIndex);
end;

That Special Folder

I am now on my second post with Windows Live Write, I think I'll stick with for a bit to see how it works out for me. As I was browsing through some of the code samples I put together for me to experiment (or whatever other reason I had for putting something together) I had come across this one for SHGetSpecialFolderPath. This may be a long post, but it is fairly straight forward.

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShlObj, ShLwApi;

const
// Some redefined for readability
CSIDL_DESKTOP= $0000;
CSIDL_PROGRAMS= $0002;
CSIDL_CONTROLS= $0003;
CSIDL_PRINTERS= $0004;
CSIDL_FAVORITES= $0006;
CSIDL_STARTUP= $0007;
CSIDL_RECENT= $0008;
CSIDL_SENDTO= $0009;
CSIDL_DESKTOPDIRECTORY= $0010;
CSIDL_DRIVES= $0011;
CSIDL_NETHOOD= $0013;
CSIDL_FONTS= $0014;
CSIDL_COMMON_DOCUMENTS= $002E;
CSIDL_COMMON_FAVORITES= $001F;
CSIDL_BITBUCKET= $000A;
CSIDL_STARTMENU= $000B;
CSIDL_MYMUSIC= $000D;
CSIDL_COMMON_STARTMENU= $0016;
CSIDL_COMMON_PROGRAMS= $0017;
CSIDL_COMMON_STARTUP= $0018;
CSIDL_COMMON_DESKTOPDIRECTORY= $0019;
CSIDL_ALTSTARTUP= $0001D;
CSIDL_COMMON_ALTSTARTUP= $001E;
CSIDL_COOKIES= $0021;
CSIDL_HISTORY= $0022;
CSIDL_COMMON_TEMPLATES= $002D;
CSIDL_COMPUTERSNEARME= $003D;
CSIDL_CONNECTIONS= $0031;
CSIDL_PRINTHOOD= $001B;
CSIDL_TEMPLATES= $0015;
CSIDL_APPDATA= $0001A; //Version 4.71
CSIDL_INTERNET_CACHE= $0020; //Version 4.72
CSIDL_LOCAL_APPDATA= $001C; //Version 5.0
CSIDL_COMMON_ADMINTOOLS= $002F; //Version 5.0
CSIDL_ADMINTOOLS= $0030; //Version 5.0
CSIDL_COMMON_APPDATA= $0023; //Version 5.0
CSIDL_WINDOWS= $0024; //Version 5.0
CSIDL_SYSTEM= $0025; //Version 5.0
CSIDL_PROGRAM_FILES= $0026; //Version 5.0
CSIDL_MYPICTURES= $0027; //Version 5.0
CSIDL_PROFILE= $0028; //Version 5.0
CSIDL_PROGRAM_FILES_COMMON= $002B; //Version 5.0
CSIDL_MYVIDEO= $000E; //Version 6.0
CSIDL_PERSONAL= $0005; //Version 6.0
CSIDL_COMMON_MUSIC= $0035; //Version 6.0
CSIDL_COMMON_PICTURES= $0036; //Version 6.0
CSIDL_COMMON_VIDEO= $0037; //Version 6.0
CSIDL_CDBURN_AREA= $003B; //Version 6.0

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
Shlwapi_Ver: Real;
function Is471: Boolean;
function Is472: Boolean;
function Is5: Boolean;
function Is6: Boolean;
public
function
GetDLLVersionInfo(FileName: string): real;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
pathname: array[0..MAX_PATH] of Char;
begin
i:= Integer(ListBox1.ItemIndex);
if not SHGetSpecialFolderPath(Handle, pathname, i, False) then
pathname:= 'UNKNOWN';

Edit1.Text:= pathname;
Edit1.Hint:= Edit1.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Shlwapi_Ver:= GetDLLVersionInfo('Shlwapi.dll');
ListBox1.Items.AddObject('CSIDL_DESKTOP', TObject(CSIDL_DESKTOP));
ListBox1.Items.AddObject('CSIDL_PROGRAMS', TObject(CSIDL_PROGRAMS));
ListBox1.Items.AddObject('CSIDL_CONTROLS', TObject(CSIDL_CONTROLS));
ListBox1.Items.AddObject('CSIDL_PRINTERS', TObject(CSIDL_PRINTERS));
ListBox1.Items.AddObject('CSIDL_FAVORITES', TObject(CSIDL_FAVORITES));
ListBox1.Items.AddObject('CSIDL_STARTUP', TObject(CSIDL_STARTUP));
ListBox1.Items.AddObject('CSIDL_RECENT', TObject(CSIDL_RECENT));
ListBox1.Items.AddObject('CSIDL_SENDTO', TObject(CSIDL_SENDTO));
ListBox1.Items.AddObject('CSIDL_DESKTOPDIRECTORY', TObject(CSIDL_DESKTOPDIRECTORY));
ListBox1.Items.AddObject('CSIDL_DRIVES', TObject(CSIDL_DRIVES));
ListBox1.Items.AddObject('CSIDL_NETHOOD', TObject(CSIDL_NETHOOD));
ListBox1.Items.AddObject('CSIDL_FONTS', TObject(CSIDL_FONTS));
ListBox1.Items.AddObject('CSIDL_COMMON_DOCUMENTS', TObject(CSIDL_COMMON_DOCUMENTS));
ListBox1.Items.AddObject('CSIDL_COMMON_FAVORITES', TObject(CSIDL_COMMON_FAVORITES));
ListBox1.Items.AddObject('CSIDL_BITBUCKET', TObject(CSIDL_BITBUCKET));
ListBox1.Items.AddObject('CSIDL_STARTMENU', TObject(CSIDL_STARTMENU));
ListBox1.Items.AddObject('CSIDL_MYMUSIC', TObject(CSIDL_MYMUSIC));
ListBox1.Items.AddObject('CSIDL_COMMON_STARTMENU', TObject (CSIDL_COMMON_STARTMENU));
ListBox1.Items.AddObject('CSIDL_COMMON_PROGRAMS', TObject(CSIDL_COMMON_PROGRAMS));
ListBox1.Items.AddObject('CSIDL_COMMON_STARTUP', TObject(CSIDL_COMMON_STARTUP));
ListBox1.Items.AddObject('CSIDL_COMMON_DESKTOPDIRECTORY', TObject(CSIDL_COMMON_DESKTOPDIRECTORY));
ListBox1.Items.AddObject('CSIDL_ALTSTARTUP', TObject(CSIDL_ALTSTARTUP));
ListBox1.Items.AddObject('CSIDL_COMMON_ALTSTARTUP', TObject(CSIDL_COMMON_ALTSTARTUP));
ListBox1.Items.AddObject('CSIDL_COOKIES', TObject(CSIDL_COOKIES));
ListBox1.Items.AddObject('CSIDL_HISTORY', TObject(CSIDL_HISTORY));
ListBox1.Items.AddObject('CSIDL_COMMON_TEMPLATES', TObject(CSIDL_COMMON_TEMPLATES));
ListBox1.Items.AddObject('CSIDL_COMPUTERSNEARME', TObject(CSIDL_COMPUTERSNEARME));
ListBox1.Items.AddObject('CSIDL_CONNECTIONS', TObject(CSIDL_CONNECTIONS));
ListBox1.Items.AddObject('CSIDL_PRINTHOOD', TObject(CSIDL_PRINTHOOD));
ListBox1.Items.AddObject('CSIDL_TEMPLATES', TObject(CSIDL_TEMPLATES));
if Is471 then
ListBox1.Items.AddObject('CSIDL_APPDATA', TObject(CSIDL_APPDATA));
if Is472 then
ListBox1.Items.AddObject('CSIDL_INTERNET_CACHE', TObject(CSIDL_INTERNET_CACHE));
if Is5 then
begin
ListBox1.Items.AddObject('CSIDL_LOCAL_APPDATA', TObject (CSIDL_LOCAL_APPDATA));
ListBox1.Items.AddObject('CSIDL_COMMON_ADMINTOOLS', TObject(CSIDL_COMMON_ADMINTOOLS));
ListBox1.Items.AddObject('CSIDL_ADMINTOOLS', TObject(CSIDL_ADMINTOOLS));
ListBox1.Items.AddObject('CSIDL_COMMON_APPDATA', TObject (CSIDL_COMMON_APPDATA));
ListBox1.Items.AddObject('CSIDL_WINDOWS', TObject(CSIDL_WINDOWS));
ListBox1.Items.AddObject('CSIDL_SYSTEM', TObject(CSIDL_SYSTEM));
ListBox1.Items.AddObject('CSIDL_PROGRAM_FILES', TObject (CSIDL_PROGRAM_FILES));
ListBox1.Items.AddObject('CSIDL_MYPICTURES', TObject(CSIDL_MYPICTURES));
ListBox1.Items.AddObject('CSIDL_PROFILE', TObject(CSIDL_PROFILE));
ListBox1.Items.AddObject('CSIDL_PROGRAM_FILES_COMMON', TObject(CSIDL_PROGRAM_FILES_COMMON));
end;
if is6 then
begin
ListBox1.Items.AddObject('CSIDL_MYVIDEO', TObject(CSIDL_MYVIDEO));
ListBox1.Items.AddObject('CSIDL_PERSONAL', TObject(CSIDL_PERSONAL));
ListBox1.Items.AddObject('CSIDL_COMMON_MUSIC', TObject(CSIDL_COMMON_MUSIC));
ListBox1.Items.AddObject('CSIDL_COMMON_PICTURES', TObject(CSIDL_COMMON_PICTURES));
ListBox1.Items.AddObject('CSIDL_COMMON_VIDEO', TObject(CSIDL_COMMON_VIDEO));
ListBox1.Items.AddObject('CSIDL_CDBURN_AREA', TObject(CSIDL_CDBURN_AREA));
end;
end;

function TForm1.GetDLLVersionInfo(FileName: string): real;
var
dllhandle: THandle;
myDllGetVersion: DllGetVersionProc;
dvi: TDllVersionInfo;
hr: HRESULT;
begin
dllhandle:= LoadLibrary(PAnsiChar(FileName));
if (handle=0) then
RaiseLastOSError;
try
myDllGetVersion:= GetProcAddress(dllhandle,'DllGetVersion');
if Assigned(myDllGetVersion) then
begin
FillChar(dvi, SizeOf(dvi), 0);
dvi.cbSize := SizeOf(dvi);
hr:= myDllGetVersion(dvi);
if hr = NOERROR then
Result:= dvi.dwMajorVersion + (dvi.dwMinorVersion/100)
else
Result:= 0;
end;
finally
FreeLibrary(dllhandle);
end;
end;

function TForm1.Is471: Boolean;
begin
Result:= Shlwapi_Ver >= 4.71;
end;

function TForm1.Is472: Boolean;
begin
Result:= Shlwapi_Ver >= 4.72;
end;

function TForm1.Is5: Boolean;
begin
Result:= Shlwapi_Ver >= 5.0;
end;

function TForm1.Is6: Boolean;
begin
Result:= Shlwapi_Ver >= 6.0;
end;

end.

A RT_BITMAP told me so

As hinted to in a previous post, there are many resources (images) contained within standard files on your computer. There are a number of ways to access these resources. You could use a program such as AIconExtract to extract the resources or you could simply access and load the resources at runtime. I was messing around and wanted to browse the image resources of standard files on my computer. A lot of files contain sized image resources strung together. I quickly came up with an ImageList Display application. This sample loads a bitmap resource into a TImageList and allows for the scrolling through the images in the imagelist. Rather than get too verbose, I’ll let the code do the talking.

type
TForm2 = class(TForm)
FileEdit1: TFileEdit;
ImageList1: TImageList;
ListBox1: TListBox;
Image1: TImage;
SpinEdit1: TSpinEdit;
StaticText1: TStaticText;
procedure FileEdit1Change(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure ListBox1KeyPress(Sender: TObject; var Key: Char);
private
procedure ClearImage;
procedure ClearImageList;
public
procedure
LoadBitmapNames(pFileName, pResType: PChar; Items: TStrings);
procedure AddResourceBitMaps(imagelist: TImageList; lpLibFileName: PChar;
const resname: string);
end;

var
Form2: TForm2;

implementation

resourcestring
StrUnableToOpen = 'Unable to open %s.';
StrDImagesInImage = '%d images in Imagelist.';
{$R *.dfm}

procedure TForm2.AddResourceBitMaps(imagelist: TImageList; lpLibFileName: PChar;
const resname: string);
var
handle: THandle;
bitmap: TBitMap;
MaskColor: TColor;
begin
handle := LoadLibrary(lpLibFileName);
if (handle=0) then
RaiseLastOSError;
bitmap:= TBitMap.Create;
try
bitmap.LoadFromResourceName(handle, resname);
imagelist.Height:= bitmap.Height;
imagelist.Width:= bitmap.Height;
MaskColor:= bitmap.Canvas.Pixels[0,bitmap.height-1];
imagelist.AddMasked(bitmap, MaskColor);
finally
bitmap.Free;
FreeLibrary(handle);
end;
end;

procedure TForm2.ClearImage;
begin
Image1.Picture.Graphic:= Nil;
end;

procedure TForm2.ClearImageList;
begin
ImageList1.Clear;
end;

procedure TForm2.FileEdit1Change(Sender: TObject);
begin
if
Sender is TFileEdit then
begin
SpinEdit1.Value:= 0;
ClearImage;
LoadBitmapNames(PAnsiChar(TFileEdit(Sender).Text), RT_BITMAP,
ListBox1.Items);
end;
end;

procedure TForm2.ListBox1Click(Sender: TObject);
var
i: Integer;
begin
if Sender is TListBox then
begin
if
TListBox(Sender).SelCount 0 then
begin
for i := 0 to TListBox(Sender).Count - 1 do
begin
if
TListBox(Sender).Selected[i] then
begin
ClearImage;
ClearImageList;
AddResourceBitMaps(ImageList1, PAnsiChar(FileEdit1.Text), TListBox(Sender).Items[i]);
StaticText1.Caption:= Format(StrDImagesInImage, [ImageList1.Count]);
SpinEdit1.MaxValue:= ImageList1.Count - 1;
SpinEdit1.MinValue:= 0;
SpinEdit1.Value:= 0;
SpinEdit1Change(Sender);
end;
end;
end;
end;
end;

procedure TForm2.ListBox1KeyPress(Sender: TObject; var Key: Char);
begin
ListBox1Click(Sender);
end;

function EnumResNameProc(hMod: THandle; ResType, ResName: pchar;
Lines: TStrings): boolean; stdcall;
var
dw: dword;
begin
dw := dword(ResName);
if (hiword(dw) = 0) then
Lines.Add('#'+IntToStr(dw))
else
Lines.Add(ResName);
Result:= True;
end;

procedure TForm2.LoadBitmapNames(pFileName, pResType: PChar; Items: TStrings);
var
FileHandle: THandle;
begin
Items.Clear;
FileHandle:= LoadLibraryEx(pFilename,0,LOAD_LIBRARY_AS_DATAFILE);
try
if (FileHandle = INVALID_HANDLE_VALUE) then
raise EAccessViolation.Create(Format(StrUnableToOpen, [pFileName]));
if (filehandle > 0) then
EnumResourceNames(FileHandle,pResType,@EnumResNameProc,longint(Items))
else
Items.Clear;
finally
FreeLibrary(FileHandle);
end;
end;


procedure TForm2.SpinEdit1Change(Sender: TObject);
begin
ClearImage;
ImageList1.GetBitmap(SpinEdit1.Value,Image1.Picture.Bitmap);
end;

end.


For those that are interested in some trivial stuff, the source can be downloaded HERE.

Tray it a bit easier

There are a number of neat components available when installing Borland Development Studio. Unfortunately, there are not always a lot of demos readily available for a quick reference for basic use. As I was browsing through some outdated applications I came across one that minimized to the system tray. I also recalled there is now a TTrayIcon installed with a base BDS install. The TTrayIcon component makes it a lot easier (and cuts out quite a bit of code) to minimize your application icon to the system tray.
type
TForm1 = class(TForm)
TrayIcon1: TTrayIcon;
procedure TrayIcon1Click(Sender: TObject);
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
SendMessage(handle, WM_SYSCOMMAND, SC_RESTORE, 0);
end;

procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
case Msg.CmdType of
SC_MINIMIZE: begin
Visible:= False;
TrayIcon1.Visible:= True;
end;
SC_RESTORE: begin
Visible:= True;
TrayIcon1.Visible:= False;
end;
else
Inherited;
end;
end;

TypInfo is cool!

uses
TypInfo;

type
TColorState = (CS_Red, CS_Blue, CS_Green);

procedure TForm1.Button1Click(Sender: TObject);
var
colorstate: TColorState;
begin
ColorState:= TColorState(GetEnumValue(TypeInfo(TColorState),'CS_Red'));
Edit1.Text:= GetEnumName(TypeInfo(TColorState), Ord(ColorState));
end;

Reading Stuff

Information in this document subject to change without notice.
All Software source code published is for demonstration and knowledge sharing purposes only. The Code is supplied "as is" without warranty as to result, performance or merchantability. Use at your own risk.
The opinions expressed herein are the opinions of the author and do not reflect those of any other entity.