Delphi

RGP4FGFRB5YK

It can be so easy to have your application pop up an email window.
Assuming that an a mail reader is installed.

Uses ShellAPI;

ShellExecute(0,'open','mailto:DePaasHaas@DePaasHaas.com?subject=nice job', NIL, NIL, SW_SHOWNORMAL);

You must have the component TNMSMTP from FastNet tools. This component is included in Delphi 4-5 Professional and Enterprise

procedure TForm1.Button1Click(Sender:Object);
Begin
NMSMTP1.Host := 'mail.host.com';
NMSMTP1.UserID:= 'username';
NMSMTP1.Connect;
NMSMTP1.PostMessage.FromAddress:='webmaster@swissdelphicenter.ch';
NMSMTP1.PostMessage.ToAddress.Text := 'user@host.com';
NMSMTP1.PostMessage.Body.Text := 'This is the message';
NMSMTP1.PostMessage.Subject:='Mailsubject;
NMSMTP1.SendMail;
showmessage('Mail sent !');
end;

To get a list of fonts available we have to use EnumFontFamilies or EnumFonts Win32 API functions. For a description of the differences between those two functions please refer to Win32 SDK documentation. I'll use the first one (EnumFontFalimiles) for this example.

Win32 API provides several enumeration functions for various tasks. There are functions capable of enumerating installed fonts, printers and so on. All those enumerating functions require you to pass a callback function, actually the function pointer, as one of its parameters.

A callback function is one function coded and provided to the system by the programmer. The system uses the function, the programmer passes as a parameter to an EnumXXXX function, to pass the requested information back.

Here is how you might code a call to EnumFontFamilies function:

var
DC: HDC;
begin
DC := GetDC(0); { get screen's device context }
try
EnumFontFamilies(DC, nil, @EnumFontsProc, LongInt(ComboBox1));
finally
ReleaseDC(0, DC); { release device context }
end;
end;

The first parameter, DC, is a device context. Check "Device Contexts" topic of the Win32 SDK for more info on device contexts. We are passing screen's device context here since we are interested for screen fonts.

The second parameter is a PChar specifying the family name of the desired fonts. Since we want all the available information we pass nil.

The third parameter is the pointer to the callback function we provide. We didn't actually code it yet. We'll do that in a minute. As you know the "@ operator returns the address of a variable, or of a function, procedure, or method; that is, @ constructs a pointer to its operand" as Delphi's online help states.

The last parameter is a Longint. Anything that could be typecasted as a LongInt could be passed here. It's up to us to decide what to pass.
Remember, an object could be typecasted to a LongInt as
Longint(MyObject)
and then pass it to the function.

Here is how the EnumFontsProc, the callback function provided by the programmer, might look like:

function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontName: string;
CB : TComboBox;
begin
CB := TComboBox(Data);
FontName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
if (CB.Items.IndexOf(FontName) < 0) then if (FontType = TRUETYPE_FONTTYPE) then CB.Items.Add(FontName); Result := 1; end; For a complete description of the TEnumLogFont and TNewTextMetric please refer to Win32 SDK. I think it's enough to say that they hold all the info the system could provide us regarding a font. They are declared in Windows.pas. The FontType could be one of the following integer constants declared in Windows.pas too RASTER_FONTTYPE = 1; DEVICE_FONTTYPE = 2; TRUETYPE_FONTTYPE = 4; Here is how this mechanism works: Windows randomly selects one font of each available type family, since we have passed nil as the second parameter to EnumFontFamilies, and passes the available information for that font to your callback function, EnumFontsProc in this case. The enumeration will continue until either the callback return 0 (we constantly retrun 1) or there are no more fonts to enumerate. Inside the EnumFontsProc we might examine each font passed and do what we want to do with the available information. In the above code I just add the FontNames to a ComboBox items. Following is a class I've coded to make the task easier: type TFontType = (ftRaster, ftDevice, ftTrueType); (*----------------------------------------------------------------------------------*) TFontInfo = class private FShortName : string; FFullName : string; FStyle : string; FLF : TLogFont; FFontType : TFontType; FTM : TNewTextMetric; public property FullName : string read FFullName ; property ShortName : string read FShortName; property Style : string read FStyle ; property FontType : TFontType read FFontType ; property TM : TNewTextMetric read FTM ; property LF : TLogFont read FLF ; end; (*----------------------------------------------------------------------------------*) TFontList = class private procedure ClearList; procedure AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer); public List : TStringList; constructor Create; destructor Destroy; override; procedure RefreshFontInfo; end; { TFontList } (*----------------------------------------------------------------------------------*) constructor TFontList.Create; begin inherited Create; List := TStringList.Create; List.Sorted := True; end; (*----------------------------------------------------------------------------------*) destructor TFontList.Destroy; begin ClearList; inherited Destroy; end; (*----------------------------------------------------------------------------------*) procedure TFontList.ClearList; begin while List.Count > 0 do
begin
TFontInfo(List.Objects[0]).Free;
List.Delete(0);
end;
end;
(*----------------------------------------------------------------------------------*)
function EnumFontsProc(var EnumLogFont: TEnumLogFont; var TextMetric: TNewTextMetric; FontType: Integer; Data: LPARAM): Integer; stdcall;
var
FontList : TFontList;
begin
FontList := TFontList(Data);
FontList.AddFont(EnumLogFont, TextMetric, FontType);
Result := 1;
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.AddFont(EnumLogFont: TEnumLogFont; TextMetric: TNewTextMetric; FontType: Integer);
var
FI : TFontInfo;
begin
FI := TFontInfo.Create;

FI.FShortName := StrPas(EnumLogFont.elfLogFont.lfFaceName);
FI.FFullName := StrPas(EnumLogFont.elfFullName);
FI.FStyle := StrPas(EnumLogFont.elfStyle);
FI.FLF := EnumLogFont.elfLogFont;

case FontType of
RASTER_FONTTYPE : FI.FFontType := ftRaster;
DEVICE_FONTTYPE : FI.FFontType := ftDevice;
TRUETYPE_FONTTYPE : FI.FFontType := ftTrueType;
end;

FI.FTM := TextMetric;

List.AddObject(FI.FShortName, FI);
end;
(*----------------------------------------------------------------------------------*)
procedure TFontList.RefreshFontInfo;
var
DC: HDC;
begin
ClearList;
DC := GetDC(0);
try
EnumFontFamilies(DC, nil, @EnumFontsProc, Longint(Self));
finally
ReleaseDC(0, DC);
end;
end;


And here is an example use:

procedure TForm1.Button1Click(Sender: TObject);
var
FontList : TFontList;
begin
ListBox1.Clear;
FontList := TFontList.Create;
try
FontList.RefreshFontInfo;
ListBox1.Items.AddStrings(FontList.List);
finally
FontList.Free;
end;
end;

You must interface with the Windows Shell API module to let
Windows know that your application accepts dropped files (this
can be done in your main form's create event), and then you must
respond to the drag events as they happen by creating an event
handler.

The following is an example of a Delphi form that accepts dropped
files and adds the names of the files to a memo component:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
procedure WMDROPFILES(var Message: TWMDROPFILES);
message WM_DROPFILES;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses ShellApi;

procedure TForm1.FormCreate(Sender: TObject);
begin
{Let Windows know we accept dropped files}
DragAcceptFiles(Form1.Handle, True);
end;

procedure TForm1.WMDROPFILES(var Message: TWMDROPFILES);
var
NumFiles : longint;
i : longint;
buffer : array[0..255] of char;
begin
{How many files are being dropped}
NumFiles := DragQueryFile(Message.Drop,
-1,
nil,
0);
{Accept the dropped files}
for i := 0 to (NumFiles - 1) do begin
DragQueryFile(Message.Drop,
i,
@buffer,
sizeof(buffer));
Form1.Memo1.Lines.Add(buffer);
end;
end;

end.

function SetPrivilege(aPrivilegeName : string;
aEnabled : boolean ): boolean;
var
TPPrev,
TP : TTokenPrivileges;
Token : THandle;
dwRetLen : DWord;
begin
Result := False;
OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES
or TOKEN_QUERY, @Token );

TP.PrivilegeCount := 1;
if( LookupPrivilegeValue(nil, PChar( aPrivilegeName ),
TP.Privileges[ 0 ].LUID ) ) then
begin
if( aEnabled )then
TP.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
else
TP.Privileges[0].Attributes:= 0;

dwRetLen := 0;
Result := AdjustTokenPrivileges(Token,False,TP,
SizeOf( TPPrev ),
TPPrev,dwRetLen );
end;

CloseHandle( Token );
end;


function WinExit( iFlags : integer ) : boolean;
// possible Flags:
// EWX_LOGOFF
// EWX_REBOOT
// EWX_SHUTDOWN
begin
Result := True;
if( SetPrivilege( 'SeShutdownPrivilege', true ) ) then
begin
if( not ExitWindowsEx( iFlags, 0 ) )then
begin
Result := False;
end;
SetPrivilege( 'SeShutdownPrivilege', False )
end
else
begin
Result := False;
end;
end;

{ define Global vars }

var
Form1: TForm1;
StartButton: hWnd;
OldBitmap: THandle;
NewImage: TPicture;

{ put the Code in the OnCreate event of your form }

procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage := TPicture.create;
NewImage.LoadFromFile('C:\Windows\Circles.BMP');
StartButton := FindWindowEx
(FindWindow(
'Shell_TrayWnd', nil),
0,'Button', nil);
OldBitmap := SendMessage(StartButton,
BM_SetImage, 0,
NewImage.Bitmap.Handle);
end;

{ OnDestroy-Event }

procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton,BM_SetImage,0,OldBitmap);
NewImage.Free;
end;