Delphi

RGP4FGFRB5YK

greatdelphi.blogspot.com (great delphi) — Fri, 25 Nov 2011 15:00:00 +0000

RGP4FGFRB5YK

Send Email from Delphi

greatdelphi.blogspot.com (great delphi) — Sun, 22 Aug 2010 09:03:00 +0000

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);

send e-mail 1

greatdelphi.blogspot.com (great delphi) — Fri, 20 Aug 2010 09:02:00 +0000

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;

How to get list of font available from system, and it's info / properties ?

greatdelphi.blogspot.com (great delphi) — Wed, 18 Aug 2010 09:00:00 +0000

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;

How do I accept files that are dropped on my application?

greatdelphi.blogspot.com (great delphi) — Mon, 16 Aug 2010 08:59:00 +0000

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.

Logout, or restart NT

greatdelphi.blogspot.com (great delphi) — Sat, 14 Aug 2010 08:57:00 +0000

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;

How to change windows start button bitmap

greatdelphi.blogspot.com (great delphi) — Thu, 12 Aug 2010 08:55:00 +0000

{ 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;

Windows Registry

greatdelphi.blogspot.com (great delphi) — Tue, 10 Aug 2010 08:52:00 +0000

This code demonstrates use of windows registery and function overloading to read from registery:
if key doesnt exist it's created and Default passed to key value ReadReg(KeyToRead,DefaultValue)
to write to registery:
writereg(KeyToWrite,ValueToKey)
Supports integer,string and boolean types, other type can be similary added.}

unit module1;

interface

uses Windows, registry;

function WriteReg(Key:string;value:integer) :boolean; overload;
function WriteReg(Key:string;value:boolean) :boolean; overload;
function WriteReg(Key:string;value:String) :boolean; overload;
function ReadReg(Key:string;default:String='') :string; overload;
function ReadReg(Key:string;default:integer=0) :integer; overload;
function ReadReg(Key:string;default:boolean=false):boolean;overload;

const
ApplicationName:string ='MyProgram'; //Your Programname

implementation

function ReadReg(Key:string;default:integer=0):integer;
var
Registry: TRegistry;
begin
Registry :=TRegistry.Create;
Registry.RootKey :=HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ ApplicationName,True);
if registry.ValueExists(key) =true then
result:=Registry.readinteger(key)
else
begin
Registry.Writeinteger(key,default);
result:=Registry.readinteger(key);
end;
Registry.Free;
end;

function ReadReg(Key:string;default:string=''):string;
var
Registry : TRegistry;
begin
Registry := TRegistry.Create;
Registry.RootKey :=HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ApplicationName,True);
if registry.ValueExists(key) then
readreg := Registry.readstring(key)
else
begin
Registry.Writestring(key,default);
Readreg := Registry.readstring(key);
end;
Registry.Free;
end;

function ReadReg(Key:string;default:boolean=false):boolean;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
Registry.RootKey := HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ApplicationName,True);
if registry.ValueExists(key) then
readreg:=Registry.readbool(key)
else
begin
Registry.Writebool(key,default);
readreg:=Registry.readbool(key);
end;
Registry.Free;
end;

function WriteReg(Key:string;value:boolean):boolean;
var Registry: TRegistry;
begin
Registry:=TRegistry.Create;
Registry.RootKey:=HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ApplicationName,True);
registry.WriteBool(key,value);
result:= registry.KeyExists(key);
Registry.Free;
end;

function WriteReg(Key:string;value:string):boolean;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
Registry.RootKey := HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ApplicationName,True);
registry.Writestring(key,value);
result:= registry.KeyExists(key);
Registry.Free;
end;

function WriteReg(Key:string;value:integer):boolean;
var
Registry: TRegistry;
begin
Registry := TRegistry.Create;
Registry.RootKey := HKEY_CURRENT_USER;
Registry.OpenKey('\software\'+ApplicationName,True);
registry.Writeinteger(key,value);
writereg:= registry.KeyExists(key);
Registry.Free;
end;

Compare dates

Uses SysUtils;
...
if(Date < EncodeDate( 2000, 1, 1 )) then
Showmessage(' The date is ' + DateToStr(Date));
…

DragDrop with the windows explorer

greatdelphi.blogspot.com (great delphi) — Sun, 08 Aug 2010 08:50:00 +0000

unit Unit1;

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject); protected
procedure WMDROPFILES (var Msg: TMessage); message WM_DROPFILES;

private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation
uses shellapi;

{$R *.DFM}

procedure TForm1.WMDROPFILES (var Msg: TMessage);
var i,anzahl, size : integer;
Dateiname : PChar;

begin
inherited;
anzahl := DragQueryFile(Msg.WParam, $FFFFFFFF,Dateiname,255);
for i := 0 to (anzahl - 1) do
begin
size := DragQueryFile(Msg.WParam, i , nil, 0) + 1;
Dateiname:= StrAlloc(size);
DragQueryFile(Msg.WParam,i , Dateiname, size);
listbox1.items.add(StrPas(Dateiname)); StrDispose(Dateiname);
end;
DragFinish(Msg.WParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Form1.Handle, true);
end;

end.

Get the current Domain and Username

greatdelphi.blogspot.com (great delphi) — Fri, 06 Aug 2010 08:47:00 +0000

Found in the Win32.hlp

type
PTokenUser = ^TTokenUser;
_TOKEN_USER = record
User: TSIDAndAttributes;
end;
TTokenUser = _TOKEN_USER;

procedure getCurrentUserAndDomain(var User, Domain: String);
var
hProcess, hAccessToken: THandle;
InfoBuffer: array[0..1000] of Char;
szAccountName, szDomainName: array [0..200] of Char;
dwInfoBufferSize, dwAccountSize, dwDomainSize: DWORD;
pUser: PTokenUser;
snu: SID_NAME_USE;
begin
dwAccountSize:=200;
dwDomainSize:=200;
hProcess:=GetCurrentProcess;
OpenProcessToken(hProcess,TOKEN_READ,hAccessToken);
GetTokenInformation(hAccessToken,TokenUser,@InfoBuffer[0],1000,
dwInfoBufferSize);
pUser:=PTokenUser(@InfoBuffer[0]);
LookupAccountSid(nil, pUser.User.Sid, szAccountName, dwAccountSize, szDomainName, dwDomainSize, snu);
User:=szAccountName;
Domain:=szDomainName;
CloseHandle(hAccessToken);
end;

Get the username and computer name from a Win95

greatdelphi.blogspot.com (great delphi) — Wed, 04 Aug 2010 08:45:00 +0000

computer For Win95, you can find it in the registry - but this is not portable to NT. A safer way (and one which is portable to NT) would be to use the Win32 calls GetComputerName and GetUserName, both of which are defined in the Windows unit. Each of these functions takes a buffer as its first parameter and the length of the buffer as its second.
The function definitions are shown below:

function GetComputerName(lpBuffer:PChar;
var nSize:DWORD): BOOL; stdcall;
function GetUserName(lpBuffer :PChar;
var nSize: DWORD): BOOL; stdcall;
Use them like this:

function GetWindowsUserName : string;
const
cnMaxLen = 254;
var
sUserName : string;
dwUserNameLen : DWord;
begin
dwUserNameLen:=cnMaxLen-1;
SetLength(sUserName,cnMaxLen);
GetUserName(Pchar(sUserName),dwUserNameLen);
SetLength(sUserName,dwUserNameLen);
result:=sUserName;
if dwUserNameLen=cnMaxLen-1 then result:='';
end;

Set the Wallpaper on Windows98/2000 when ActiveDesktop is turned on

greatdelphi.blogspot.com (great delphi) — Mon, 02 Aug 2010 08:43:00 +0000

You may have noticed that using SystemParametersInfo to change the wallpaper when ActiveDesktop is turned on doesn't work. The reason is because you need to use the IActiveDesktop COM interface. Using SystemParametersInfo still works, but it doesn't update the wallpaper.

Note that the IActiveDesktop interface requires a Shell32.dll version >= 4.71. The document titled "Get a File Version" demonstrates how to check the file version and uses the shell32.dll as an example.

Here is an example of using IActiveDesktop to work with
the wallpaper. It assumes that you have 3 labels on a form
and two buttons with the default names.

uses
ComObj, // For CreateComObject and Initialization/Finalization of COM
ShlObj; // For IActiveDesktop

{ The CLASS ID for ActiveDesktop is not defined in ShlObj, while the IID is so we define it here. }
const
CLSID_ActiveDesktop : TGUID = '{75048700-EF1F11D0-9888-06097DEACF9}';

{ Demonstrate getting the Wallpaper }
procedure TForm1.Button1Click(Sender: TObject);
var
ActiveDesktop : IActiveDesktop;
CurrentWallpaper : string;
CurrentPattern : string;
WallpaperOptions : TWallpaperOpt;
TmpBuffer : PWideChar;
begin
// Create the ActiveDesktop COM Object
ActiveDesktop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
// We now need to allocate some memory to get the current Wallpaper.
// However, tmpBuffer is a PWideChar which means 2 bytes make
// up one Char. In order to compenstate for the WideChar, we
// allocate enough memory for MAX_PATH*2
tmpBuffer := AllocMem(MAX_PATH*2);
try
ActiveDesktop.GetWallpaper(tmpBuffer, MAX_PATH*2, 0);
CurrentWallpaper := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentWallpaper <> '' then
Label1.Caption := 'Current Wallpaper: ' + CurrentWallpaper
else
Label1.Caption := 'No Wallpaper set';

// Now get the current Wallpaper options.
// The second parameter is reserved and must be 0.
WallpaperOptions.dwSize := SizeOf(WallpaperOptions);
ActiveDesktop.GetWallpaperOptions(WallpaperOptions, 0);
case WallpaperOptions.dwStyle of
WPSTYLE_CENTER : Label2.Caption := 'Centered';
WPSTYLE_TILE : Label2.Caption := 'Tiled';
WPSTYLE_STRETCH : Label2.Caption := 'Stretched';
WPSTYLE_MAX : Label2.Caption := 'Maxed';
end;
{Now get the desktop pattern. The pattern is a string of decimals whose bit pattern represents a picture. Each decimal represents the on/off state of the 8 pixels in that row. }
tmpBuffer := AllocMem(256);
try
ActiveDesktop.GetPattern(tmpBuffer, 256, 0);
CurrentPattern := tmpBuffer;
finally
FreeMem(tmpBuffer);
end;
if CurrentPattern <> '' then
Label3.Caption := CurrentPattern
else
Label3.Caption := 'No Pattern set';
end;
{ Demonstrate setting the wallpaper }
procedure TForm1.Button2Click(Sender: TObject);
var
ActiveDesktop: IActiveDesktop;
begin
ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
ActiveDesktop.SetWallpaper('c:\downloads\images\test.bmp', 0);
ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;

Responds:
Good programming. But I just calling

SystemParametersInfo( SPI_SETDESKWALLPAPER, 0, @WallpaperBMPFileAndPath[1], 3);

Shutdown windows

greatdelphi.blogspot.com (great delphi) — Sat, 31 Jul 2010 08:41:00 +0000

Parameters:
EWX_SHUTDOWN : shut down windows(Power off)
EWX_REBOOT : reboot windows
EWX_POWEROFF : Standby mode
EWX_LOGOFF : Log Off

procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindowsEx(EWX_SHUTDOWN,0);
end;

or use rundll32.exe

uses ShellAPI;

function ExecuteFile(const FileName, Params,DefaultDir : string;
ShowCmd: Integer) : THandle;
var
zFileName, zParams, zDir : array[0..79] of Char;
begin
Result :=ShellExecute(Application.MainForm.Handle, nil,
StrPCopy(zFileName, FileName),StrPCopy(zParams,Params), StrPCopy(zDir, DefaultDir), ShowCmd);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ExecuteFile('Rundll.exe','user,exitwindows','',SW_SHOW);
end;

Get windows and system directory

greatdelphi.blogspot.com (great delphi) — Thu, 29 Jul 2010 08:38:00 +0000

function GetWinDir: String;
var
dir : array [0..max_path] of char;
begin
GetWindowsDirectory(dir, max_path);
result:=StrPas(dir);
end;

function GetSysDir: String;
var
dir : array [0..max_path] of char;
begin
GetSystemDirectory(dir, max_path);
result:=StrPas(dir);
end;

Tile an image

greatdelphi.blogspot.com (great delphi) — Tue, 27 Jul 2010 08:32:00 +0000

procedure TForm1.Button1Click(Sender:TObject);
var
x,y : Integer;
Bmp : TBitmap;
begin
bmp:=TBitmap.Create;
bmp.LoadFromFile('c:\windows\streifen.bmp');
for x:=0 to (image1.width div bmp.width) do
for y:=0 to (image1.height div bmp.height) do
Image1.Canvas.Draw(x*bmp.width,y*bmp.height,bmp);
bmp.Free;
end;

Convert BMP to JPG

greatdelphi.blogspot.com (great delphi) — Sun, 25 Jul 2010 08:30:00 +0000

uses jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
bmp : TImage;
jpg : TJpegImage;
begin
bmp := TImage.Create(nil);
jpg := TJpegImage.Create;
bmp.picture.bitmap.LoadFromFile('c:\picture.bmp');
jpg.Assign( bmp.picture.bitmap );
//Here you can set the jpg object's
//properties as compression, size and more
jpg.SaveToFile('c:\picture.jpg');
jpg.Free;
bmp.Free;
end;

change the graphic mode

greatdelphi.blogspot.com (great delphi) — Fri, 23 Jul 2010 08:29:00 +0000

procedure TForm1.FormCreate(Sender: TObject);
var devmode : TDEVMODE;
d : INTEGER;
litem : TListItem;
p : ^TDevmode;
begin
devmode.dmSize := SizeOf(TDEVMODE);
devmode.dmDriverExtra := 0; d := 0;
listview1.Columns[0].Width := 400;
While EnumDisplaySettings(nil, d, devmode) do
with devmode do
begin
Inc(d);
litem := listview1.Items.Add;
litem.Caption:=Format('Modus %3d : %dx%d, %d Farben(%d Hz)', [d,dmPelsWidth,dmPelsHeight,1 shl(dmBitsPerPel),dmDisplayFrequency]);
new(p);
p^ := Devmode;
litem.Data := p;
end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
ChangeDisplaySettings(TDevmode(listview1.Selected.data^),0);
end;

Detect Disk Free

greatdelphi.blogspot.com (great delphi) — Wed, 21 Jul 2010 08:27:00 +0000

DiskFree(n) //where n = number.

0 = the current drive you are working in. 1 = A, 2 = B, 3 = C, 4 = D etc.
DiskFree(3);// C drive.
DiskFree returns the number of free bytes on the specified drive number.

Open and close CD

greatdelphi.blogspot.com (great delphi) — Mon, 19 Jul 2010 08:26:00 +0000

Procedure Opendoor;
Begin
mciSendString('Set cdaudio door open', nil, 0, 0);
End;

Procedure CloseDoor;
Begin
mciSendString('Set cdaudio door closed', nil, 0, 0);
End;

note : Remember to include the unit MMSYSTEM

Detect SoundCard

greatdelphi.blogspot.com (great delphi) — Sat, 17 Jul 2010 08:24:00 +0000

Uses MMSystem;
Function IsSoundCardInstalled:Boolean;
Begin
Result:=(waveOutGetNumDevs>0);
End;

Hide the application from tasklist (Ctrl+Alt+Del)

greatdelphi.blogspot.com (great delphi) — Thu, 15 Jul 2010 08:23:00 +0000

implementation

function RegisterServiceProcess(dwProcessID, dwType: DWord) : DWord; stdcall;
external 'KERNEL32.DLL';

{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,1);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessID,0);
end;

Make the whole form behave like the title bar

greatdelphi.blogspot.com (great delphi) — Tue, 13 Jul 2010 08:21:00 +0000

Uses Messages;
...
public
procedure WMNCHitTest(var Message: TWMNCHitTest); message;
WM_NCHITTEST;
end;
...
procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
var
P : TPoint;
begin
inherited;
P := ScreenToClient(SmallPointToPoint(Message.Pos));
with imgTitle do
if (P.X >= Left) and (P.X < Left + Width) and (P.Y >= Top)
and (P.Y < Top + Height) then
Message.Result := htCaption;
end;

Make a form always on top

greatdelphi.blogspot.com (great delphi) — Sun, 11 Jul 2010 08:20:00 +0000

with Form1 do
SetWindowPos(Handle,
HWND_TOPMOST, Left, Top,Width, Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

Hide the main form

greatdelphi.blogspot.com (great delphi) — Fri, 09 Jul 2010 08:19:00 +0000

Application.ShowMainForm := false;

Send files to the recycle bin

greatdelphi.blogspot.com (great delphi) — Wed, 07 Jul 2010 08:17:00 +0000

procedure RecycleFile(s : string);
var
SHFileOpStruct : TSHFileOpStruct;
begin
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_DELETE; // we want to delete a file...
pFrom := PChar(s); //... this file ...
pTo := nil;
fFlags := FOF_ALLOWUNDO; //... able to "Undo" (recycle)
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(SHFileOpStruct); // to the Recycle Bin
end;