tag:blogger.com,1999:blog-67205763328964861802024-02-07T10:17:25.504+07:00GEMAR MUSIKiwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.comBlogger232125tag:blogger.com,1999:blog-6720576332896486180.post-27620005098570358142012-03-04T12:16:00.000+07:002011-05-30T20:30:31.442+07:00TV Online<div style="-moz-border-radius: 10px 10px 10px 10px; -moz-box-shadow: 2px 2px 4px rgb(139, 210, 104); background: url("https://7707928374904518111-a-1802744773732722657-s-sites.googlegroups.com/site/kintunan/bluelineNotepaper.JPG") repeat scroll 0% 0% transparent; color: black; padding: 10px;"><div style="color: blue; text-align: center;"><span style="font-size: large;"><a href="http://gemarmusik.blogspot.com/2011/03/tv-online.html">STREAMING TV ONLINE INDONESIA</a></span></div><span style="font-size: large;"> </span> <br />
<div style="height: 550px; margin-left: auto; margin-right: auto; overflow: hidden; text-align: center; width: 580px;"><iframe frameborder="0" height="759" scrolling="no" src="http://id.imediabiz.com/MivoTV.swf?r=%27%20+%20Math.round%28Math.random%28%29%20*%2099999%29%20+%20%27" style="border: 0px none; left: 0px; position: relative; top: -250px;" width="569"></iframe></div></div><div style="color: blue; text-align: justify;"><span style="font-size: x-large;"> </span><span style="font-size: x-large;"><a href="http://gemarmusik.blogspot.com/2011/04/rctisctvglobal-tv-isi-postingan.html"><blink>RCTI, TRANSTV, SCTV, GLOBALTV</blink></a></span></div><div style="border: 1px solid rgb(238, 238, 238); height: 550px; overflow: auto; padding: 10px; width: 580px;"><div id="fb-root"></div><script src="http://connect.facebook.net/en_US/all.js#appId=202527326443365&xfbml=1">
</script><fb:comments href="http://gemarmusik.blogspot.com/2011/03/tv-online.html" num_posts="100" width="570"></fb:comments></div>iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com1tag:blogger.com,1999:blog-6720576332896486180.post-85754317735734010722011-07-10T17:21:00.000+07:002011-07-10T17:21:35.071+07:00create a registry entry in the autorun keyThere's a RunOnce key in the registry.<br />
When a user logs on, the programs in the run-once list are run just once,<br />
and then the entries will be removed.<br />
The "runonce" key is normally used by setup programs to install<br />
software after a machine has been rebooted.<br />
<br />
<br />
// Add the application to the registry...<br />
<br />
procedure DoAppToRunOnce(RunName, AppName: string);<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', True);<br />
WriteString(RunName, AppName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
// Check if the application is in the registry...<br />
// Prüfen, ob Anwendung in der Registry vorhanden ist...<br />
<br />
function IsAppInRunOnce(RunName: string): Boolean;<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', False);<br />
Result := ValueExists(RunName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
// Remove the application from the registry...<br />
// Anwendung aus der Registry entfernen...<br />
<br />
procedure DelAppFromRunOnce(RunName: string);<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce', True);<br />
if ValueExists(RunName) then DeleteValue(RunName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
{<br />
Applications under the key "Run" will be executed<br />
each time the user logs on.<br />
{<br />
<br />
{<br />
Jede Anwendung, die im Schlüssel Run aufgeführt ist, wird beim<br />
jedem Windowsstart ausgeführt. Betrifft Anwendungen, die immer<br />
mit Windows gestartet werden sollen...<br />
}<br />
<br />
<br />
// Add the application to the registry...<br />
// Anwendung in die Registry aufnehmen...<br />
<br />
procedure DoAppToRun(RunName, AppName: string);<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);<br />
WriteString(RunName, AppName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
// Check if the application is in the registry...<br />
// Prüfen, ob Anwendung in der Registry vorhanden ist...<br />
<br />
function IsAppInRun(RunName: string): Boolean;<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False);<br />
Result := ValueExists(RunName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
// Remove the application from the registry...<br />
// Anwendung aus der Registry entfernen...<br />
<br />
procedure DelAppFromRun(RunName: string);<br />
var<br />
Reg: TRegistry;<br />
begin<br />
Reg := TRegistry.Create;<br />
with Reg do<br />
begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', True);<br />
if ValueExists(RunName) then DeleteValue(RunName);<br />
CloseKey;<br />
Free;<br />
end;<br />
end;<br />
<br />
// Examples, Beispiele<br />
<br />
// Add app, Anwendung aufnehmen...<br />
DoAppToRun('Programm', 'C:\Programs\XYZ\Program.exe');<br />
<br />
// Is app there ? Ist Anwendung vorhanden?<br />
if IsAppInRun('Programm') then...<br />
<br />
// Remove app, Anwendung entfernen<br />
DelAppFromRun('Programm');iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-66918497518129740182011-07-10T12:30:00.002+07:002011-07-10T12:30:55.045+07:00shutdown / reboot / logoff Windows 9x/NT/Me/2000/XP/Win7<span class="sourcecode"><span style="font-family: Courier New; font-size: x-small;"><b>function </b>MyExitWindows(RebootParam: Longword): Boolean;<br />
<b>var<br />
</b>TTokenHd: THandle;<br />
TTokenPvg: TTokenPrivileges;<br />
cbtpPrevious: DWORD;<br />
rTTokenPvg: TTokenPrivileges;<br />
pcbtpPreviousRequired: DWORD;<br />
tpResult: Boolean;<br />
<b>const<br />
</b>SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';<br />
<b>begin<br />
if </b>Win32Platform = VER_PLATFORM_WIN32_NT <b>then<br />
begin<br />
</b>tpResult := OpenProcessToken(GetCurrentProcess(),<br />
TOKEN_ADJUST_PRIVILEGES <b>or </b>TOKEN_QUERY,<br />
TTokenHd);<br />
<b>if </b>tpResult <b>then<br />
begin<br />
</b>tpResult := LookupPrivilegeValue(<b>nil</b>,<br />
SE_SHUTDOWN_NAME,<br />
TTokenPvg.Privileges[0].Luid);<br />
TTokenPvg.PrivilegeCount := 1;<br />
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;<br />
cbtpPrevious := SizeOf(rTTokenPvg);<br />
pcbtpPreviousRequired := 0;<br />
<b>if </b>tpResult <b>then<br />
</b>Windows.AdjustTokenPrivileges(TTokenHd,<br />
False,<br />
TTokenPvg,<br />
cbtpPrevious,<br />
rTTokenPvg,<br />
pcbtpPreviousRequired);<br />
<b>end</b>;<br />
<b>end</b>;<br />
Result := ExitWindowsEx(RebootParam, 0);<br />
<b>end</b>;<br />
<br />
<span style="color: navy;"><i>// Example to shutdown Windows:<br />
<br />
</i></span><b>procedure </b>TForm1.Button1Click(Sender: TObject);<br />
<b>begin<br />
</b>MyExitWindows(EWX_POWEROFF <b>or </b>EWX_FORCE);<br />
<b>end</b>;<br />
<br />
<span style="color: navy;"><i>// Example to reboot Windows:<br />
<br />
</i></span><b>procedure </b>TForm1.Button1Click(Sender: TObject);<br />
<b>begin<br />
</b>MyExitWindows(EWX_REBOOT <b>or </b>EWX_FORCE);<br />
<b>end</b>;<br />
<br />
<br />
<span style="color: navy;"><i>// Parameters for MyExitWindows()<br />
<br />
<br />
{************************************************************************}<br />
<br />
{2. Console Shutdown Demo}<br />
<br />
</i></span><b>program </b>Shutdown;<br />
<span style="color: navy;"><i>{$APPTYPE CONSOLE}<br />
<br />
</i></span><b>uses<br />
</b>SysUtils,<br />
Windows;<br />
<br />
<span style="color: navy;"><i>// Shutdown Program<br />
// (c) 2000 NeuralAbyss Software<br />
// www.neuralabyss.com<br />
<br />
</i></span><b>var<br />
</b>logoff: Boolean = False;<br />
reboot: Boolean = False;<br />
warn: Boolean = False;<br />
downQuick: Boolean = False;<br />
cancelShutdown: Boolean = False;<br />
powerOff: Boolean = False;<br />
timeDelay: Integer = 0;<br />
<br />
<b>function </b>HasParam(Opt: Char): Boolean;<br />
<b>var<br />
</b>x: Integer;<br />
<b>begin<br />
</b>Result := False;<br />
<b>for </b>x := 1 <b>to </b>ParamCount <b>do<br />
if </b>(ParamStr(x) = '-' + opt) <b>or </b>(ParamStr(x) = '/' + opt) <b>then </b>Result := True;<br />
<b>end</b>;<br />
<br />
<b>function </b>GetErrorstring: <b>string</b>;<br />
<b>var<br />
</b>lz: Cardinal;<br />
err: <b>array</b>[0..512] <b>of </b>Char;<br />
<b>begin<br />
</b>lz := GetLastError;<br />
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, <b>nil</b>, lz, 0, @err, 512, <b>nil</b>);<br />
Result := <b>string</b>(err);<br />
<b>end</b>;<br />
<br />
<b>procedure </b>DoShutdown;<br />
<b>var<br />
</b>rl, flgs: Cardinal;<br />
hToken: Cardinal;<br />
tkp: TOKEN_PRIVILEGES;<br />
<b>begin<br />
</b>flgs := 0;<br />
<b>if </b>downQuick <b>then </b>flgs := flgs <b>or </b>EWX_FORCE;<br />
<b>if not </b>reboot <b>then </b>flgs := flgs <b>or </b>EWX_SHUTDOWN;<br />
<b>if </b>reboot <b>then </b>flgs := flgs <b>or </b>EWX_REBOOT;<br />
<b>if </b>poweroff <b>and </b>(<b>not </b>reboot) <b>then </b>flgs := flgs <b>or </b>EWX_POWEROFF;<br />
<b>if </b>logoff <b>then </b>flgs := (flgs <b>and </b>(<b>not </b>(EWX_REBOOT <b>or </b>EWX_SHUTDOWN <b>or </b>EWX_POWEROFF))) <b>or<br />
</b>EWX_LOGOFF;<br />
<b>if </b>Win32Platform = VER_PLATFORM_WIN32_NT <b>then<br />
begin<br />
if not </b>OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES <b>or </b>TOKEN_QUERY,<br />
hToken) <b>then<br />
</b>Writeln('Cannot open process token. [' + GetErrorstring + ']')<br />
<b>else<br />
begin<br />
if </b>LookupPrivilegeValue(<b>nil</b>, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) <b>then<br />
begin<br />
</b>tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;<br />
tkp.PrivilegeCount := 1;<br />
AdjustTokenPrivileges(hToken, False, tkp, 0, <b>nil</b>, rl);<br />
<b>if </b>GetLastError <> ERROR_SUCCESS <b>then<br />
</b>Writeln('Error adjusting process privileges.');<br />
<b>end<br />
else<br />
</b>Writeln('Cannot find privilege value. [' + GetErrorstring + ']');<br />
<b>end</b>;<br />
<span style="color: navy;"><i>{ if CancelShutdown then<br />
if AbortSystemShutdown(nil) = False then<br />
Writeln(\'Cannot abort. [\' + GetErrorstring + \']\')<br />
else<br />
Writeln(\'Cancelled.\')<br />
else<br />
begin<br />
if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then<br />
Writeln(\'Cannot go down. [\' + GetErrorstring + \']\')<br />
else<br />
Writeln(\'Shutting down!\');<br />
end;<br />
}<br />
</i></span><b>end</b>;<br />
<span style="color: navy;"><i>// else begin<br />
</i></span>ExitWindowsEx(flgs, 0);<br />
<span style="color: navy;"><i>// end;<br />
</i></span><b>end</b>;<br />
<br />
<b>begin<br />
</b>Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)');<br />
Writeln('(c) 2000 NeuralAbyss Software. All Rights Reserved.');<br />
<b>if </b>HasParam('?') <b>or </b>(ParamCount = 0) <b>then<br />
begin<br />
</b>Writeln('Usage: shutdown [-akrhfnc] [-t secs]');<br />
Writeln(' -k: don''t really shutdown, only warn.');<br />
Writeln(' -r: reboot after shutdown.');<br />
Writeln(' -h: halt after shutdown.');<br />
Writeln(' -p: power off after shutdown');<br />
Writeln(' -l: log off only');<br />
Writeln(' -n: kill apps that don''t want to die.');<br />
Writeln(' -c: cancel a running shutdown.');<br />
<b>end<br />
else<br />
begin<br />
if </b>HasParam('k') <b>then </b>warn := True;<br />
<b>if </b>HasParam('r') <b>then </b>reboot := True;<br />
<b>if </b>HasParam('h') <b>and </b>reboot <b>then<br />
begin<br />
</b>Writeln('Error: Cannot specify -r and -h parameters together!');<br />
Exit;<br />
<b>end</b>;<br />
<b>if </b>HasParam('h') <b>then </b>reboot := False;<br />
<b>if </b>HasParam('n') <b>then </b>downQuick := True;<br />
<b>if </b>HasParam('c') <b>then </b>cancelShutdown := True;<br />
<b>if </b>HasParam('p') <b>then </b>powerOff := True;<br />
<b>if </b>HasParam('l') <b>then </b>logoff := True;<br />
DoShutdown;<br />
<b>end</b>;<br />
<b>end</b>.<br />
<br />
<br />
<br />
</span><br />
<br />
<span style="color: navy;"><i>// Parameters for MyExitWindows()<br />
</i><br />
<br />
<b>EWX_LOGOFF</b> <br />
<br />
Shuts down all processes running in the security context of the process that called the<br />
ExitWindowsEx function. Then it logs the user off.<br />
<br />
Alle Prozesse des Benutzers werden beendet, danach wird der Benutzer abgemeldet.<br />
<br />
<b>EWX_POWEROFF<br />
</b> <br />
Shuts down the system and turns off the power.<br />
The system must support the power-off feature.<br />
Windows NT/2000/XP:<br />
The calling process must have the SE_SHUTDOWN_NAME privilege.<br />
<br />
Fährt Windows herunter und setzt den Computer in den StandBy-Modus,<br />
sofern von der Hardware unterstützt.<br />
<br />
<b>EWX_REBOOT<br />
<br />
</b>Shuts down the system and then restarts the system.<br />
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.<br />
<br />
Fährt Windows herunter und startet es neu.<br />
<br />
<b>EWX_SHUTDOWN</b> <br />
<br />
Shuts down the system to a point at which it is safe to turn off the power.<br />
All file buffers have been flushed to disk, and all running processes have stopped.<br />
If the system supports the power-off feature, the power is also turned off.<br />
Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege.<br />
<br />
Fährt Windows herunter.<br />
<br />
<br />
<b>EWX_FORCE</b> <br />
<br />
Forces processes to terminate. When this flag is set,<br />
the system does not send the WM_QUERYENDSESSION and WM_ENDSESSION messages.<br />
This can cause the applications to lose data.<br />
Therefore, you should only use this flag in an emergency.<br />
<br />
Die aktiven Prozesse werden zwangsweise und ohne Rückfrage beendet.<br />
<br />
<b>EWX_FORCEIFHUNG<br />
</b> <br />
Windows 2000/XP: Forces processes to terminate if they do not respond to the<br />
WM_QUERYENDSESSION or WM_ENDSESSION message. This flag is ignored if EWX_FORCE is used.<br />
<br />
Windows 2000/XP: Die aktiven Prozesse werden aufgefordert, sich selbst zu beenden und<br />
müssen dies bestätigen. Reagieren sie nicht, werden sie zwangsweise beendet.<br />
</span></span>iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-23595074243432957152011-07-08T13:52:00.000+07:002011-07-08T13:52:59.634+07:00Get a list of computers in a network<span style="font-size: 12px;"><b>Code:</b></span><br />
<span style="font-size: 12px;"><b>==========================================================</b></span><br />
<b>type</b> <br />
PNetResourceArray = ^TNetResourceArray; <br />
TNetResourceArray = <b>array</b>[0..100] <b>of</b> TNetResource; <br />
<br />
<b>function</b> CreateNetResourceList(ResourceType: DWord; <br />
NetResource: PNetResource; <br />
out Entries: DWord; <br />
out List: PNetResourceArray): Boolean; <br />
<b>var</b> <br />
EnumHandle: THandle; <br />
BufSize: DWord; <br />
Res: DWord; <br />
<b>begin</b> <br />
Result := False; <br />
List := Nil; <br />
Entries := 0; <br />
<b>if</b> WNetOpenEnum(RESOURCE_GLOBALNET, <br />
ResourceType, <br />
0, <br />
NetResource, <br />
EnumHandle) = NO_ERROR <b>then</b> <b>begin</b> <br />
try <br />
BufSize := $4000; // 16 kByte <br />
GetMem(List, BufSize); <br />
try <br />
<b>repeat</b> <br />
Entries := DWord(-1); <br />
FillChar(List^, BufSize, 0); <br />
Res := WNetEnumResource(EnumHandle, Entries, List, BufSize); <br />
<b>if</b> Res = ERROR_MORE_DATA <b>then</b> <br />
<b>begin</b> <br />
ReAllocMem(List, BufSize); <br />
<b>end;</b> <br />
until Res <> ERROR_MORE_DATA; <br />
Result := Res = NO_ERROR; <br />
<b>if</b> not Result <b>then</b> <br />
<b>begin</b> <br />
FreeMem(List); <br />
List := Nil; <br />
Entries := 0; <br />
<b>end;</b> <br />
except <br />
FreeMem(List); <br />
raise; <br />
<b>end;</b> <br />
<b>finally</b> <br />
WNetCloseEnum(EnumHandle); <br />
<b>end;</b> <br />
<b>end;</b> <br />
<b>end;</b> <br />
<br />
<br />
<b>procedure</b> ScanNetworkResources(ResourceType, DisplayType: DWord; List: TStrings); <br />
<br />
<b>procedure</b> ScanLevel(NetResource: PNetResource); <br />
<b>var</b> <br />
Entries: DWord; <br />
NetResourceList: PNetResourceArray; <br />
i: Integer; <br />
<b>begin</b> <br />
<b>if</b> CreateNetResourceList(ResourceType, NetResource, Entries, NetResourceList) <b>then</b> try <br />
<b>for</b> i := 0 <b>to</b> Integer(Entries) - 1 do <br />
<b>begin</b> <br />
<b>if</b> (DisplayType = RESOURCEDISPLAYTYPE_GENERIC) or <br />
(NetResourceList[i].dwDisplayType = DisplayType) <b>then</b> <b>begin</b> <br />
List.AddObject(NetResourceList[i].lpRemoteName, <br />
Pointer(NetResourceList[i].dwDisplayType)); <br />
<b>end;</b> <br />
<b>if</b> (NetResourceList[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 <b>then</b> <br />
ScanLevel(@NetResourceList[i]); <br />
<b>end;</b> <br />
<b>finally</b> <br />
FreeMem(NetResourceList); <br />
<b>end;</b> <br />
<b>end;</b> <br />
<b>begin</b> <br />
ScanLevel(Nil); <br />
<b>end;</b> <br />
<br />
<br />
<b>procedure</b> TForm1.Button1Click(Sender: TObject); <br />
<b>begin</b> <br />
ScanNetworkResources(RESOURCETYPE_DISK, RESOURCEDISPLAYTYPE_SERVER, ListBox1.Items); <br />
<b>end;</b><br />
<span style="font-size: 12px;"><b><br />
</b></span>iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-19066709320961582932011-07-07T10:00:00.002+07:002011-07-07T10:00:26.860+07:00Dragging controls and forms the easy wayQuestion/Problem/Abstract:<br />
This article shows a technique to drag a form without caption other than responding to NC_HITTEST messages. This technique can also be used to accomplish the dragging of Windowed controls inside the form.<br />
Answer:<br />
<br />
<br />
<br />
The code bellow was created when I was writting a component to allow the dragging of forms without captions. First I found code using the NC_HITTEST message, but the technique presented here offers a lot of other possibilities since it can be applied to any windowed control (not only forms), and will allow you to move them on the form with only 2 or 3 lines of code.<br />
<br />
It consists of sendind a WM_SYSCOMMAND message to the desired window (remember that all windowed controls are considered windows on the Windows OS :-) with the correct parameters set, and the window will behave as if the user had started dragging the window by clicking on its caption (this works even with windows without captions, like text boxes.)<br />
<br />
The funny part was that this parameter for the WM_SYSCOMMAND message isn't documented (it isn't on my Windows SDK help). I've discovered it while debugging an application. I've put a handler for the WM_SYSCOMMAND message and was showing on the screen all the values for its parameters and to my surprise, when I started to drag the form the value $F012 poped-up. Then I tried to send it to the form and it didn't worked. After a while I figure out how to do it correctly and the code for this follows:<br />
<br />
Put the code bellow on the OnMouseDown handler for any form:<br />
<br />
procedure TForm1.FormMouseDown(Sender: TObject;<br />
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);<br />
begin<br />
if Button = mbLeft then<br />
begin<br />
ReleaseCapture;<br />
Perform(WM_SYSCOMMAND, $F012, 0);<br />
end;<br />
end;<br />
<br />
You can also put this code on the OnMouseDown of a single panel or a group of panels, effectively creating a new drag point for the form. When the user tries to drag the panel you send the message above to the form and a dragging operation will start. It is easier to accomplish this with this method than using the NC_HITTEST message:<br />
<br />
procedure TForm1.Panel1MouseDown(Sender: TObject;<br />
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);<br />
begin<br />
if Button = mbLeft then<br />
begin<br />
ReleaseCapture;<br />
Perform(WM_SYSCOMMAND, $F012, 0);<br />
end;<br />
end;<br />
<br />
If you write Panel1.Perform(WM_SYSCOMMAND, $F012, 0) the panel will start moving inside the form as if it was itself a form. When you release the mouse it will stay were you left it (no additional code required).<br />
<br />
This code can be much useful sometimes, but it is very very simple. Hope you liked it.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-83530214464118433722011-07-07T08:52:00.005+07:002011-07-07T08:52:59.483+07:00Adding Drag & Drop to a TListBoxHow do I do drag and drop in a TListbox?<br />
<br />
Adding Drag and Drop facilities to a listbox is a matter of checking to see if there is an item under the mouse pointer in the MouseDown event, and if so save the item text and the index number to variables. Then check the MouseUp event to see if there is a different item under the mouse. If so, delete the old item and insert a copy of it in the new position.<br />
<br />
Firstly, add three variables to the private section:<br />
<br />
{ Private declarations }<br />
Dragging: Boolean;<br />
OldIndex: Integer;<br />
TempStr: String;<br />
<br />
Then add the following code to the MouseUp and MouseDown events:<br />
<br />
procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;<br />
Shift: TShiftState; X, Y: Integer);<br />
var <br />
Index: integer;<br />
begin<br />
if Dragging then<br />
begin<br />
Index := ListBox1.ItemAtPos(point(x, y), true);<br />
if (Index > -1) and (Index <> OldIndex) then<br />
begin<br />
ListBox1.Items.Delete(OldIndex);<br />
ListBox1.Items.Insert(Index, TempStr);<br />
ListBox1.ItemIndex := Index; <br />
end;<br />
end; <br />
Dragging := false;<br />
end;<br />
<br />
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;<br />
Shift: TShiftState; X, Y: Integer);<br />
var <br />
Index: integer;<br />
begin<br />
Index := ListBox1.ItemAtPos(point(x, y), true);<br />
if Index > -1 then<br />
begin<br />
TempStr := ListBox1.Items[Index];<br />
OldIndex := Index;<br />
Dragging := true;<br />
end; <br />
end;iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-35497900705471932912011-07-07T08:52:00.002+07:002011-07-07T08:52:32.016+07:00Incremental Searches with a TListboxHow can I create a form that has a list box that I can perform an incremental search on?<br />
<br />
There are a couple of ways to do this. One's hard and slow, the other easy and fast (we're going to take the easy and fast option).<br />
<br />
For those of you who aren't familiar with incremental searching with list boxes, the concept is simple: A user types part of a string into an edit box, then the list box automatically selects one of its items that most closely matches the value typed by the user. For example of this, open up any topic search dialog in a Windows Help file. If you type into the edit box, the list will scroll to the value that most closely matches what you type.<br />
<br />
Why is creating a capability like this essential? Because it's tedious to scroll through a list that has lots of items. Imagine if a list contained hundreds of unsorted items. To get to the value you're looking for would take a long time if you only had the capability of scrolling through the list using the vertical scroll bar. But if you knew at least part of the value you're trying to find, entering it into an edit box and getting the item you want immediately is a much more attractive solution.<br />
<br />
Let's delve into what you have to do make this work. First, here's the unit code for a sample form I produced:<br />
<br />
unit uinclist;<br />
<br />
interface<br />
<br />
uses<br />
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br />
StdCtrls;<br />
<br />
type<br />
TForm1 = class(TForm)<br />
ListBox1: TListBox;<br />
Edit1: TEdit;<br />
procedure FormCreate(Sender: TObject);<br />
procedure Edit1Change(Sender: TObject);<br />
private<br />
{ Private declarations }<br />
public<br />
{ Public declarations }<br />
end;<br />
<br />
var<br />
Form1: TForm1;<br />
<br />
implementation<br />
<br />
{$R *.DFM}<br />
<br />
procedure TForm1.FormCreate(Sender: TObject);<br />
{This is a test string to load into the list box at runtime}<br />
CONST ListStrings = 'United States'#13'Guatemala'#13'Mexico'#13+<br />
'El Salvador'#13'Costa Rica'#13'Yucatan'#13+<br />
'China'#13'Japan'#13'Thailand'#13'Switzerland'#13+<br />
'Germany'#13'Lichtenstein'#13'Jamaica'#13'Greece'+<br />
'Turkey'#13'Ireland'#13'United Kingdom'#13'Scotland'+<br />
'Canada'#13'Uruguay'#13'Paraguay'#13'Cuba'#13+<br />
'Spain'#13'Italy'#13'France'#13'Portugal'#13'New Zealand'#13+<br />
'Austria'#13'Australia'#13'Philippines'#13'Korea'#13+<br />
'Malaysia'#13'Tibet'#13'Nepal'#13'India'#13'Sri Lanka'#13+<br />
'Pakistan'#13+'Saudi Arabia'#13'United Arab Emerates'#13'Iran'#13+<br />
'Ukraine'#13'Belarus'#13+<br />
'Chechen'#13'Yugoslavia'#13'Czechoslovakia'#13'Slovina'#13'Kazakhstan'#13+<br />
'Egypt'#13'Morocco'#13'Macedonia'#13'Cyprus'#13'Finland'#13+<br />
'Norway'#13'Sweden'#13'Denmark'#13'Netherlands'#13'Lithuania'#13;<br />
begin<br />
ListBox1.Items.SetText(ListStrings);<br />
end;<br />
<br />
procedure TForm1.Edit1Change(Sender: TObject);<br />
var<br />
S : Array[0..255] of Char;<br />
begin<br />
StrPCopy(S, Edit1.Text);<br />
with ListBox1 do<br />
ItemIndex := Perform(LB_SELECTSTRING, 0, LongInt(@S));<br />
end;<br />
<br />
end.<br />
<br />
Form1 has two controls: a TEdit and a TListBox. Notice that during FormCreate, I loaded up the value of the list box with the huge string of countries. This was only for testing purposes. How you load up your list is up to you. Now, the trick to making the incremental search is in the OnChange event of Edit1. I've used the Windows message LB_SELECTSTRING to perform the string selection for me. Let's talk about the message.<br />
<br />
LB_SELECTSTRING is one of the members of the WinAPI list box message family (all preceeded by LB_) that manipulates all aspects of a list box object in Windows. The message takes two parameters: wParam, the index from which the search should start; and lParam, the address of the null-terminated string to search on. Since WinAPI calls require null-terminated strings, use either a PChar or an Array of Char to pass string values. It's more advantageous to use a an Array of Char if you know a string value won't exceed a certain length. You don't have to manually allocate and de-allocate memory with an Array of Char, as opposed to a PChar that requires you to use GetMem or New and FreeMem to allocate and de-allocate memory.<br />
<br />
In any case, to convert a Pascal string to a null-terminated string, just use StrPCopy to copy the contents of the Pascal string into the null-terminated string. Once that's done, all we have to do is pass the address of the null-terminated string into the wParam parameter of LB_SELECTSTRING, and that's done by using the @ symbol.<br />
<br />
When we use Perform to execute the LB_SELECTSTRING message, the message will return the item index of the matching list item. Then all that's left to do is assign the ItemIndex property of the list box to the return value of the message. The net result is that the list box will scroll to and select the list element that was found.<br />
<br />
There are several list box messages you can perform in Delphi. If you bring up the help system and do a topic search, enter LB_ in the edit box, and peruse the list of messages.<br />
<br />
Copyright © 1995, 1996, 1997 Brendan V. Delumpa All Rights Reserved<br />
Delphi Expert Eddie Shipman adds the following useful information:<br />
<br />
This procedure can be applied to TComboBox by changing to this code:<br />
<br />
procedure TForm1.ComboBox1Change(Sender: TObject);<br />
var<br />
S : Array[0..255] of Char;<br />
begin<br />
StrPCopy(S, TComboBox(Sender).Text);<br />
with ComboBox1 do<br />
ItemIndex := Perform(CB_SELECTSTRING, 0, LongInt(@S));<br />
end;iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-76399559092883760692011-07-07T08:51:00.002+07:002011-07-07T08:51:55.264+07:00Manipulating a TRadioGroup's Individual ButtonsIs there a way to manipulate the appearance of the individual buttons in a TRadioGroup?<br />
<br />
This subject falls into the yeah, it's something you could do, but should you category. In other words, don't do it just because it's possible. Especially because for what I'll be discussing here, this is pretty much undocumented stuff, and purposely hidden from obvious access.<br />
<br />
The Delphi engineers hid a lot of stuff from the visible interface for a good reason: Unless you really know what you're doing and understand the workings of Delphi and the VCL components and its object hierarchy, it's better to leave the internal stuff alone. In fact, I'd venture that 98% of the time you won't need to access any of the hidden features of Delphi. But as we all know, it's that remaining 2% that always kills us. I ran into one of those 2% situations recently.<br />
<br />
I had created a form that had a few TRadioGroups with up to 20 items in each on it. The selections specified some standard query selection criteria, which my users could then just set with a few clicks of the mouse, press the OK button and the program would produce a formatted report. No possible mistyping, so no worries about entering in wrong information for the criteria-matching. However, one of my users had a problem with the form in that because the radio groups were side-by-side, it was difficult to immediately tell which selection she had made from one group to the next. So she asked me if I could change the appearance of the item she checked.<br />
<br />
So what I did was take advantage of the fact that objects that can act as containers all have an array property called Components, which holds the component index of a contained component relative to the container. TRadioGroup is nothing more than a TWinControl descendant (a few levels down) with a collection of TRadioButtons. And conveniently, the radio buttons in the group are indexed with the ItemIndex property, which in turn corresponds to the index of the Components array. So all we have to do to access an individual TRadioButton in a TRadioGroup is to typecast a Components element as a TRadioButton. What I came up with is fairly simple, but remember, this is undocumented stuff.<br />
<br />
Let's look at the code:<br />
<br />
unit main;<br />
<br />
interface<br />
<br />
uses<br />
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br />
StdCtrls, ExtCtrls, Spin;<br />
<br />
type<br />
TForm1 = class(TForm)<br />
RadioGroup1: TRadioGroup;<br />
procedure FormCreate(Sender: TObject);<br />
procedure RadioGroup1Click(Sender: TObject);<br />
private<br />
{ Private declarations }<br />
OldItemIndex : Integer;<br />
public<br />
{ Public declarations }<br />
end;<br />
<br />
var<br />
Form1: TForm1;<br />
<br />
implementation<br />
<br />
{$R *.DFM}<br />
<br />
procedure TForm1.FormCreate(Sender: TObject);<br />
begin<br />
OldItemIndex := -1;<br />
end;<br />
<br />
procedure TForm1.RadioGroup1Click(Sender: TObject);<br />
begin<br />
with RadioGroup1 do begin<br />
{if there was a previously set item, change it back to the<br />
default appearance first.}<br />
if (OldItemIndex > -1) then<br />
with (Components[OldItemIndex] as TRadioButton) do begin<br />
Color := clBtnFace;<br />
Font.Color := clBtnFace;<br />
Font.Style := [];<br />
end;<br />
<br />
{Now with the currently selected item, change its appearance.}<br />
with (Components[ItemIndex] as TRadioButton) do begin<br />
Color := clBlue;<br />
Font.Color := clWhite;<br />
Font.Style := [fsBold];<br />
OldItemIndex := ItemIndex;<br />
end;<br />
<br />
end;<br />
<br />
end;<br />
<br />
The unit code above depicts a simple form with a single TRadioGroup dropped on it. I filled the group up with about 20 values by hand for testing. Now what goes on is pretty straightforward. I have defined a private variable called OldItemIndex that holds the value of a previously selected item. This is a "just in case" thing in that if users change their mind about a selection, they can go back to the radio group, change the value, and the old item will revert back to its original appearance. The code is listed in the OnClick handler for RadioGroup1 above.<br />
<br />
Granted, this was pretty simple. You could do more with the TRadioButton if you wish. In fact, all the properties of TRadioButton are available. But as I said before, this is undocumented material, so use at your own risk, even if it's for a purpose as innocuous as this.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-73933687172667344752011-07-07T08:49:00.005+07:002011-07-07T08:49:55.708+07:00Reading and writing text filesHow do I read from and write to text files using Delphi?<br />
<br />
Note: There's a demonstration program accompanying this article.<br />
<br />
One of the most basic operations in practically any language is working with text files. I realize this is probably old hat to many of the more experienced programmers out there, but there are a lot of novice Delphi programmers who don't know how to work with text files at all. Several people have asked me how to open, read, and write text files, so in response to their queries, I've decided to write a quick article on the subject.<br />
<br />
In particular, people have asked me how to read a text file into a TMemo, then write its contents back to the file. The easy way to do this is with the TMemo's Lines property LoadFromFile and SaveToFile methods. Just provide a file name and poof! the file's loaded into a memo. Here are a couple of quick functions that I use to read text files into a TMemo (or any component that has a property of type TStrings).<br />
<br />
{This procedure loads any TStrings type property with the contents<br />
of a text file}<br />
procedure TextToTStrings(const List : TStrings; const FileName : String);<br />
begin<br />
with List do begin<br />
Clear;<br />
LoadFromFile(FileName);<br />
end;<br />
end;<br />
<br />
{This procedure saves the contents of any TStrings type property to a<br />
text file}<br />
procedure TStringsToText(const List : TStrings; const FileName : String);<br />
begin<br />
with List do<br />
SaveToFile(FileName);<br />
end;<br />
<br />
As you can see, the procedures are practically one-liners. While they don't seem too interesting, there is one thing about them that you should note. If you look at the code above, the first formal parameter of each of the procedures, const List : TStrings, is a TStrings type passed as a const. This is the only way you can pass a TStrings type as a formal parameter into a function or procedure. You can't pass by reference (passing by var); you'll get a compiler error. This is because unlike a variable that is of a standard type such as String or Integer, a TStrings type variable is actually an instance which, in effect, makes it a constant object. Thus, in order to use it as a formal parameter, you have to pass it as a const. Okay, onward ho!<br />
<br />
The two functions above, while useful, didn't really serve to answer the question, though they are the way to quickly and easily load from and save to text files using TMemos. Why did I go that route in the first place? Primarily because most people have asked me that question within the context of a TMemo, so I thought I'd tackle that problem first and foremost, then get down to basic text file I/O.<br />
<br />
Working with text files<br />
<br />
Delphi provides an incredibly easy way to write a program that reads and writes a text file. To do this, you perform five basic steps:<br />
<br />
1. Declare a variable of type TextFile or System.Text<br />
2. Assign a physical text file to the variable<br />
3. Open the file within a specific file mode context<br />
4. Read and write to the file as appropriate<br />
5. Close the file<br />
<br />
The first thing you do is declare a text file variable as follows:<br />
<br />
var<br />
txt : TextFile;<br />
<br />
However, System.Text is just as valid. If you do it this way though, you have to always qualify the word Text with the unit identifier System because a form's unit already contains a Text variable, so you have to point the variable declaration to the proper place. Personally, I find that simply declaring a text file variable as TextFile avoids this problem entirely. I suggest using it instead.<br />
<br />
After you've declared the text file, you have to assign the variable to a text file. This is done as follows:<br />
<br />
AssignFile(txt, 'MyText.TXT');<br />
<br />
Similarly to declaring a text file variable, you can also do a System.Assign(txt, 'MyText.TXT');. But for the same reason I explained above, it's better to use AssignFile. Finally, you have to decide how you want to manipulate the text file. This is done using one of the following three file-opening functions:<br />
Rewrite This creates a file or overwrites an existing file.<br />
Reset This opens an existing file.<br />
Append This opens an existing file, but allows you to append strings to the end of it as well.<br />
<br />
Once you've opened the file, you're ready to perform reads and writes. Using the example I outlined above, I'll show you how to read from a text file into a TMemo and write to a text file from a TMemo.<br />
<br />
Let's look at reading a text file first. The following procedures, IterTextToTStrings and IterTStringsToText, produce the exact same results as above, but use file I/O functions instead. I've preceded their names with the prefix Iter- to indicate that these procedures employ an iterative methodology for loading in the lines of a text file. Let's look at the code:<br />
<br />
{Procedure to read a text file into a TMemo}<br />
procedure IterTextToTStrings(Wnd : THandle; const List : TStrings;<br />
const FileName : String);<br />
var<br />
txt : TextFile;<br />
buf : String;<br />
begin<br />
AssignFile(txt, FileName);<br />
Reset(txt);<br />
List.Clear;<br />
{Do a LockWindowUpdate to delay the screen updates while the<br />
lines are being added. This will prevent visible scrolling<br />
during the process.}<br />
LockWindowUpdate(Wnd);<br />
while NOT EOF(txt) do begin<br />
ReadLn(txt, buf); <br />
List.Add(buf);<br />
end;<br />
LockWindowUpdate(0);<br />
CloseFile(txt);<br />
end;<br />
<br />
{Procedure to write a TMemo's contents to a file}<br />
procedure IterTStringsToText(const List : TStrings; const FileName : String);<br />
var<br />
txt : TextFile;<br />
I : Integer;<br />
begin<br />
if FileExists(FileName) then<br />
if (MessageDlg('File ' + FileName + ' exists. Overwrite?', mtConfirmation,<br />
[mbOk, mbCancel], 0) = mrCancel) then<br />
Exit;<br />
<br />
AssignFile(txt, FileName);<br />
Rewrite(txt);<br />
for I := 0 to (List.Count - 1) do begin<br />
WriteLn(txt, List[I]); <br />
end;<br />
CloseFile(txt);<br />
end;<br />
<br />
I've put in boldface the file operation you should pay attention to in each of the procedures. In the first procedure, I've employed the ReadLn function that reads a line from a text file, then performs a line feed to point the file to the next line. ReadLn takes two parameters: the text file variable, and a String variable for receiving the current line's contents. Note that once you've loaded a line into a string variable, you can do everything to it that you can do to a string. In our case, we load it as a line of a TMemo.<br />
<br />
In the second procedure, I've used the WriteLn function to write a line of text to a file. Like ReadLn above, WriteLn takes two parameters: the text file variable, and a valid string. If you don't have a properly filled string, you will probably get some weird results.<br />
<br />
After the procedures above finish their basic I/O functions, CloseFile is called to close the file. This step is absolutely imperative. If you don't perform it, you'll get a file sharing violation error when you try to access this file - and that's from any program besides your own. So never forget this step!<br />
<br />
There's an issue you should know about that concerns text files: You can't insert a line of text in the middle of an open text file, at least not very easily. You have three options: Create a new file, open an existing file, or append to an existing file. If you really need to insert a line, your best bet is to read the entire file as a an untyped or binary file into a dynamic array or a TList, insert the new line in the appropriate position, then write the entire contents of the array or list back out to the file. Needless to say, this is problematic at best.<br />
<br />
Summing it up<br />
<br />
What I've presented here is a very basic method of working with text files. However, the principle defined by the five steps I listed above is a constant. It's what you put in between the read and write operation that will make your program complex. In other words, from program to program, text file operations don't change.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-82861589661142920462011-07-07T08:49:00.002+07:002011-07-07T08:49:24.400+07:00Getting and Monitoring Caps Lock StatusHow can I display the the current status of the CAPS LOCK key in my application?<br />
<br />
There are several ways to address this, and one I have seen before is to check the KeyPress event, and modify the status according to each press of the CapsLock key. The problem with this approach is that it would not give you the necessary status at the time the application started. We therefore have to get our hands dirty to get the ideal solution, and dig into the Windows API. Luckily, the code is quite simple.<br />
<br />
We use the GetKeyState function, passing it the CapsLock key constant and receiving a return value. If the return value is zero, CapsLock is off, otherwise it is on. Simple code then, dropped into a button click event:<br />
<br />
procedure TForm1.Button1Click(Sender: TObject); <br />
begin <br />
if GetKeyState(VK_CAPITAL) > 0 then <br />
Label1.Caption := 'Caps Lock On'<br />
else <br />
Label1.Caption := 'Caps Lock Off'; <br />
end; <br />
<br />
Naturally this could easily be modified into a usable function to return the value so that it could be used by more than one routine and avoid code duplication. Firstly, modify it to return the integer status:<br />
<br />
function GetCapsLockStatus: Integer; <br />
begin <br />
Result := GetKeyState(VK_CAPITAL); <br />
end; <br />
<br />
You would call this from wherever you wanted, and one possible use would achieve the same thing as the original code:<br />
<br />
procedure TForm1.Button1Click(Sender: TObject); <br />
begin <br />
if GetCapsLockStatus > 0 then <br />
Label1.Caption := 'Caps Lock On' <br />
else <br />
Label1.Caption := 'Caps Lock Off'; <br />
end; <br />
<br />
You could also convert it to a function that returns a string:<br />
<br />
function GetCapsLockStatusString: Integer; <br />
begin <br />
if GetCapsLockStatus > 0 then <br />
Result := 'On' <br />
else <br />
Result := 'Off'; <br />
end; <br />
<br />
Usage of this would be simple, assigning the resulting string directly to a label caption:<br />
<br />
procedure TForm1.Button2Click(Sender: TObject); <br />
begin <br />
Label1.Caption := GetCapsLockStatusString; <br />
end; <br />
<br />
Once you have the original status you can either monitor keypresses for the CapsLock key (check for the virtual key constant VK_CAPITAL) and change the caption appropriately, or simply insert the call into a routine that is regularly called. Note that inserting the function call into the OnKeyPress event would work, but there would be consequences in the performance hit caused by the function running and the label being rewritten every time any key is pressed.<br />
<br />
There we go then - simple but effective use of the Windows API to achieve the desired result.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-8726969719893443822011-07-07T08:48:00.005+07:002011-07-07T08:48:51.241+07:00Disabling The System Keys from Your ApplicationWhen my application is running, I'd like to prevent users from using Ctrl-Alt-Del and Alt-Tab. What's the best way to do this?<br />
<br />
This is pretty quick one... The best way I've seen yet is to trick Windows into thinking that a screen saver is running. When Windows thinks a screensaver is active, Ctrl-Alt-Del and Alt-Tab (Win95 only for this) are disabled. You can perform this trickery by calling a WinAPI function, SystemParametersInfo. For a more in-depth discussion about what this function does, I encourage you to refer to the online help.<br />
<br />
In any case, SystemParametersInfo takes four parameters. Here's its C declaration from the Windows help file:<br />
<br />
BOOL SystemParametersInfo(<br />
UINT uiAction, // system parameter to query or set<br />
UINT uiParam, // depends on action to be taken<br />
PVOID pvParam, // depends on action to be taken<br />
UINT fWinIni // user profile update flag<br />
);<br />
<br />
For our purposes we'll set uiAction to SPI_SCREENSAVERRUNNING, uiParam to 1 or 0 (1 to disable the keys, 0 to re-enable them), pvParam to a "dummy" pointer address, then fWinIni to 0. Pretty straight-forward. Here's what you do:<br />
<br />
To disable the keystrokes, write this:<br />
<br />
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @ptr, 0);<br />
<br />
To enable the keystrokes, write this:<br />
<br />
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, @ptr, 0);<br />
<br />
Not much to it, is there? Thanks to the folks on the Borland Forums for providing this information!iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-11339130811983786622011-07-07T08:48:00.002+07:002011-07-07T08:48:23.821+07:00Disabling the Windows Screen Saver at RuntimeI've written an application that runs for several hours, and I found that when the Windows screen saver activates, it seriously affects the performance of my application. Since I'm going to be deploying the application to users, having them manually disable the screen saver is out of the question. Can I possibly disable it while my program is running?<br />
<br />
Good question, and yes you can disable the Windows screen saver at runtime. It just so happens that just before Windows activates its screen saver, it sends out a SC_SCREENSAVE message to all running programs. If any of them set the message's Result field to -1, the screen saver won't be activated. So now the problem lies with trapping the message itself.<br />
<br />
Since SC_SCREENSAVE is a system message, the best way to trap it is by writing a custom message handler for the WM_SYSCOMMAND message. It can be argued that you can just trap the message in the WndProc handler, but why go so low-level? Oh well, let's continue....<br />
<br />
To create the custom message handler for WM_SYSCOMMAND, we need to make a declaration for it in the private section of our code, then write a few simple lines to handle the SC_SCREENSAVE message. Here's the code:<br />
<br />
unit Unit1;<br />
<br />
interface<br />
<br />
uses<br />
Windows, Messages, SysUtils, Classes, <br />
Graphics, Controls, Forms, Dialogs;<br />
<br />
type<br />
TForm1 = class(TForm)<br />
private<br />
procedure WMSysCommand(var Msg : TWMSysCommand); <br />
message WM_SYSCOMMAND;<br />
public<br />
{ Public declarations }<br />
end;<br />
<br />
var<br />
Form1: TForm1;<br />
<br />
implementation<br />
<br />
{$R *.DFM}<br />
<br />
procedure TForm1.WMSysCommand(var Msg : TWMSysCommand);<br />
begin<br />
//trap the message and set its result to -1<br />
if (Msg.CmdType = SC_SCREENSAVE) then<br />
Msg.Result := -1<br />
else<br />
inherited;<br />
end;<br />
<br />
end.<br />
<br />
Notice the declaration of the procedure in the private section. You can actually name the handler anything you want. But by convention, you name your procedure to closest approximation of the message that you're handling; thus the name WMSysCommand.<br />
<br />
In the procedure itself, notice as well that unlike most other handlers, the inherited message is not called first. The reason should be obvious - if we called it first, the Result type would remain unchanged. Thus, we subject the cmdType parameter of Msg to a conditional statement to evaluate it prior to taking any action.<br />
<br />
The net result of all this? While you're program is running, the Windows Screen saver will not activate. Have fun!iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-16174021047015994322011-07-07T08:47:00.005+07:002011-07-07T08:47:54.595+07:00How to force a drop-down combo to drop its list downHow can I force a drop-down combo to drop its list down?<br />
<br />
This is done by using a Windows message called CB_SHOWDROPDOWN.<br />
<br />
I recommend that you look in the WinAPI help under messages to see what else you can do with them.<br />
<br />
The nice thing about messaging in Windows is that the calls are all handled through the Windows API SendMessage routine, which requires four parameters:<br />
<br />
1. Parameters of SendMessage function<br />
2. Window Handle (can be an object handle)<br />
3. Message — specifies the message to be sent (in our case, CB_SHOWDROPDOWN)<br />
4. wParam, a 16-bit message-dependent parameter<br />
5. lParam, a 32-bit message-dependent parameter (see WinHelp for specifics on what goes into wParam and lParam)<br />
<br />
The gist of this is that Windows messages are performed in a very standard way, so if you haven't done them much, I encourage you to investigate ways to employ them in your code.<br />
<br />
To get a combo-box list to automatically drop down when you enter it, put the following code into the OnEnter event:<br />
<br />
procedure TForm1.ComboBox1Enter(Sender: TObject);<br />
begin<br />
SendMessage(ComboBox1.handle, CB_SHOWDROPDOWN, Integer(True), 0);<br />
end;<br />
<br />
Likewise, you can close the drop-down when you exit by putting the following code into the OnExit event of the combo box:<br />
<br />
procedure TForm1.ComboBox1Exit(Sender: TObject);<br />
begin<br />
SendMessage(ComboBox1.handle, CB_SHOWDROPDOWN, Integer(False), 0);<br />
end;<br />
<br />
This is probably how the Intuit guys did it with Quicken. So go for it!iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-48456607887359724752011-07-07T08:47:00.002+07:002011-07-07T08:47:22.906+07:00Preventing a Form from Re-sizingHow can I keep a form from resizing at runtime?<br />
<br />
There are some cases in your development where you want to prevent your users from re-sizing a form. This is especially true if you want a form to behave similarly to a dialog box, but want to maintain the look of a regular window without building the form as a dialog box. True, you can easily set the form's BorderStyle property to bsSingle, but to me, that type of border style looks flat and plain. Not too exciting.<br />
<br />
The example I have below employs a Windows message called WM_GETMINMAXINFO. It's a message that is sent to a window when its size or position is about to change. And it can also be used to override a window's default maximized size and position. It can also override the window's default minimum or maximum tracking size (that is, when the user tries to resize the form using the mouse), thus restricting window sizing at runtime. Let's look at the code...<br />
<br />
unit Unit1;<br />
<br />
interface<br />
<br />
uses<br />
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;<br />
<br />
type<br />
TForm1 = class(TForm)<br />
private<br />
{ Private declarations }<br />
procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;<br />
public<br />
{ Public declarations }<br />
end;<br />
<br />
var<br />
Form1: TForm1;<br />
<br />
implementation<br />
<br />
{$R *.DFM}<br />
<br />
procedure TForm1.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);<br />
begin<br />
inherited;<br />
with Msg.MinMaxInfo^ do begin<br />
ptMinTrackSize.x:= Form1.width;<br />
ptMaxTrackSize.x:= Form1.width;<br />
ptMinTrackSize.y:= Form1.height;<br />
ptMaxTrackSize.y:= Form1.height;<br />
end;<br />
end;<br />
<br />
end.<br />
<br />
In the private section of our code, we make the procedure declaration for our message handler. Notice the message WM_GETMINMAXINFO. This tells the compiler that with the preceding procedure, we're trapping the WM_GETMINMAXINFO message. This actually allows us to name the procedure anything we want so we could make the declaration of the procedure GetWinMinMaxInformation(var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO. But by convention, message handlers have names that as closely as possible approximate the name of their prospective windows messages.<br />
<br />
Looking at the message-handling code itself, we first make a call to the inherited WMGetMinMaxInfo handler. Next, we set the x and y values of the tracking size fields of the message structure to the default width and height of the form. Maybe we should look at the structure itself. The WMGetMinMaxInfo message has a single parameter called MinMaxInfo, which is a structure defined as follows:<br />
<br />
typedef struct tagMINMAXINFO { // mmi <br />
<br />
POINT ptReserved; <br />
<br />
POINT ptMaxSize; <br />
<br />
POINT ptMaxPosition; <br />
<br />
POINT ptMinTrackSize; <br />
<br />
POINT ptMaxTrackSize; <br />
<br />
} MINMAXINFO; <br />
<br />
In ObjectPascal, this would be a record with five TPoint fields. What we did above was set the ptMin and ptMaxTrackSize fields to the size of the form. However, as you can see in the structure, we can even mess around with the ptMaxSize and ptMaxPosition fields. But that's beyond the scope of this discussion.<br />
<br />
If you think about it, this was actually a very simple thing to do. Unfortunately, with Windows, a lot of really simple things are hidden behind a veil of complexity that requires pushing through to get at what you want. In any case, have fun with the code!iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-7030359562085740142011-07-07T08:46:00.002+07:002011-07-07T08:46:50.665+07:00Set the System Date and Time in DelphiHow can I set the System Date and Time in Delphi 2.0 (setdate or settime does not exist)?<br />
<br />
Use the WinAPI call SetSystemTime. This will allow you to change the system time for the machine you're on. You can find a description of the call in the Win32 help file. Just do a search on SetSystemTime, and you'll get a pretty good discussion of the function.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-67222212252492858922011-07-07T08:45:00.003+07:002011-07-07T08:45:52.789+07:00TFileStream: Saving List Box Data at Runtime<div class="subTitle">How do I save data entered in a list box at run time without resorting to a text file or having to deal with the overhead of a table?</div><hr /> <table border="0" style="width: 623px;"><tbody>
<tr> <td bgcolor="#c0c0c0" width="623"><b>Note:</b><span style="font-size: x-small;">A </span><a href="http://www.delphicorner.f9.co.uk/files/persist.zip"><span style="font-size: x-small;">sample program</span></a><span style="font-size: x-small;"> is available. Even though this article focuses on saving a list box at runtime, it really presents a general overview of using the TFileStream class for streaming components to and from disk. This is an important distinction to make because while I use the TListBox as an example, it is possible to apply the concepts to almost all components.</span></td> </tr>
</tbody></table>Any OOP class library worth its salt supports what is called <i>streamable persistent objects</i>. Simply put, this means that an instance of a class (or at least its data) can be saved to a disk file and restored later. When a program reloads the object, it is restored in its last state, just prior to being written. The cool thing about this is that the program doesn't have to have <i>any</i> advance knowledge of the state of the object; the object itself contains all the information it needs to recreate itself when it's restored. <br />
For example, let's say you've created a program that has a list box in which people append various bits of information at run time. For many folks, saving the information to disk means iterating through all the items in the list and writing them to a text file or even a table. The program must reload the data from the external file and add the data, line by line. This is not so bad, but it can be a bit of a chore to write the code. <br />
On the other hand, using object persistence, the same program mentioned above instructs the list box to write its data to a disk file of some sort. When it wants to reload the object, all it has to do is stream it back into memory and specify the base class to write to. Remember, since all the data of the object was saved with it when it was written to disk, the object comes back to life in its original form. That's the whole idea behind object persistence. <br />
Delphi itself makes heavy use of object persistence. Every time you save a project, it streams out to disk the data contained in your objects' properties so that everything you set during your session is saved. When you reload a project, Delphi streams the object data back into your form(s) to restore everything you previously set. In fact, a form file itself is streamed to and from disk. I should note here that Delphi uses a couple of specialized stream classes, TWriter and TReader which are derived from a superclass called <i>TFiler</i>. I won't go into the details of these classes here, since I'm providing a much simpler demonstration of employing object persistence in your programs. I'll leave it up to you to research this topic further. <br />
Moving on, you might ask, "Where does employing streamable persistent objects come in handy?" The most useful cases I've found for employing them are when I've written programs that provide parameter or input criteria for processes, where the range of possible values to search on remain fairly constant from one run of the program to the next. <br />
For instance, in my line of work, almost all of my programs are typically front-ends to very complex query operations. However, the range of domains and their values don't change very often, and from client to client, the same questions are typically asked. So in these cases, I've found that simply streaming my criteria objects (these are all list objects) out to disk when I close the forms and streaming them back in when I open the forms provides a much cleaner solution to saving my criteria sets from session to session. Besides, this is very low overhead programming, since once the programs are finished with the streams, they're immediately destroyed. Not only that, I don't have to use DB.PAS or DBTables.PAS for data operations. <br />
<div class="subTitle">A simple example</div>The example I've provided here is by no means a full-fledged search program of the type I normally write. I've merely taken the parts pertinent to this article for your use. Feel free to include or modify this code to your heart's content. In any case, here's the code listing for the main form of the program. We'll discuss particulars below. <br />
<pre>unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Edit1: TEdit;
Memo1: TMemo;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListBox1DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
ListBox1.Items.Add(Edit1.Text);
Edit1.Text := '';
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
strm : TFileStream;
begin
if FileExists('MyList.DAT') then begin
strm := TFileStream.Create('MyList.DAT', fmOpenRead);
strm.ReadComponent(ListBox1);
strm.Free;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
strm : TFileStream;
begin
strm := TFileStream.Create('MyList.DAT', fmCreate);
strm.WriteComponent(ListBox1);
strm.Free;
end;
procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;
end.</pre>You were expecting some complex code, weren't you? In actuality, this stuff is incredibly simple. So why isn't it documented very well? I'd say it's because this is one of the more uncommon things done in Delphi. But for those of you who wish to really get into the innards of the environment, this stuff is a must to understand and master. Let's look a little deeper into the code. <br />
The program consists of a form with a <i>TEdit</i> and a <i>TListBox</i> dropped onto it. It has just two meaningful methods: <b>FormCreate</b> and <b>FormClose</b>. In the FormCreate method, <br />
<pre>procedure TForm1.FormCreate(Sender: TObject);
var
strm : TFileStream;
begin
if FileExists('MyList.DAT') then begin
strm := TFileStream.Create('MyList.DAT', fmOpenRead);
strm.ReadComponent(ListBox1);
strm.Free;
end;
end;</pre>the program checks for the existence of <i>MyList.DAT</i> with a call to <b>FileExists</b>, which is the stream file that holds the list box information. If it exists, the file is streamed into ListBox1; otherwise, it does nothing. With the FormClose method, <br />
<pre>procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
strm : TFileStream;
begin
strm := TFileStream.Create('MyList.DAT', fmCreate);
strm.WriteComponent(ListBox1);
strm.Free;
end;</pre>the program writes ListBox1 out to <i>MyList.DAT</i>, overwriting any previous versions of the file. <br />
That's all there is to this program. Surprisingly, this is one of the more simple things to do in Delphi, but paradoxically it's one of the most difficult things to find good information about in the manuals or help file. Granted, as I mentioned above, doing this type of stuff is fairly uncommon, but think of the implication: simple, low overhead, persistent storage without the need for tables. What was accomplished above was done in fewer than 10 lines of code — that's absolutely incredible! <br />
I urge you to play around with this technique and apply it to other things. I think you'll get a lot of mileage out of it.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-92038773394544919912011-07-07T08:45:00.000+07:002011-07-07T08:45:06.353+07:00Copying Files in Delphi: Using StreamsI'd like to be able to copy files in Delphi, but am having trouble figuring out how to do it. I've been using operating system level calls, but don't want to limited by them. Is there a way to do it in Delphi?<br />
<br />
This is one of those topics that I've gotten asked about frequently enough that I decided it's time to write a short article on how to do it. It's funny that something as basic as this is not as visible as might be expected. It falls into a category that I call, "You gotta know what you're looking for..." Essentially, it means that the technique may not be hard to implement, it's just hard to find. In any case, once you know how to do it, it's not that difficult at all.<br />
<br />
There are actually a number of ways to copy files. One way is to use untyped files along with BlockRead and BlockWrite. This also entails the use of an intermediary buffer. It works, but it can be a bit unwieldy, especially for novices. An easier way to accomplish file copying in Delphi is to use streams. As the term implies, a stream is sequential stream of data. When copying a file, you stream the file into a buffer, then stream buffer out to another file. Pretty simple in concept. Now in Delphi there are several types of streams which descend from the abstract base class TStream. I encourage you to look them up in the online help since they are beyond the scope of this discussion. But for our purposes, the descendant class that we're interested in is called TFileStream. This class allows applications to read from and write to files on disk. For simplicity's sake, I won't be going into the various intricacies of the class; again, encouraging you to study the online help. Or better yet, Ray Lischner's Book Secrets of Delphi 2 has a great discussion about streams as well (don't worry, the material applies to Delphi 3).<br />
<br />
Quick and Dirty File Copying<br />
<br />
The easiest method of copying a file with streams is called stream to stream copying. Essentially, this method involves creating a stream for the source file, and creating one for the destination file. Once that's done, it's a simple matter of copying the contents of the source stream to the destination stream. Listing 1 below shows a procedure that encapsulates stream to stream copying:<br />
<br />
{Quick and dirty stream copy}<br />
procedure FileCopy(const FSrc, FDst: string);<br />
var<br />
sStream,<br />
dStream: TFileStream;<br />
begin<br />
sStream := TFileStream.Create(FSrc, fmOpenRead);<br />
try<br />
dStream := TFileStream.Create(FDst, fmCreate);<br />
try<br />
{Forget about block reads and writes, just copy<br />
the whole darn thing.}<br />
dStream.CopyFrom(sStream, 0);<br />
finally<br />
dStream.Free;<br />
end;<br />
finally<br />
sStream.Free;<br />
end;<br />
end;<br />
<br />
Undoubtedly, you can get a lot more sophisticated with this. But for now, we'll leave it at this...iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-65802159250197683772011-07-07T08:44:00.000+07:002011-07-07T08:44:24.728+07:00How to Create a Table at Runtime<div class="subTitle">I was a VB programmer, until my recent shift to Delphi 2.0. How can I create a database in code? </div><hr /> It depends on the type of database you want to build. However, I can show you how to do it with a Paradox table. Conceivably, it stands to reason that since the TTable is database-independent and if you've got the right settings in the BDE, you should be able to create a table with the TTable component in any database. This is not necessarily true. SQL tables are normally created using the SQL call CREATE TABLE. And each server has its own conventions for creating tables and defining fields. So it's important to note this if you're working with a SQL database. The problem is that SQL databases support different data types that aren't necessarily available in the standard BDE set. For instance, MS SQL server's NUMERIC data format is not necessarily a FLOAT as it's defined in the BDE. So your best bet would probably be to create SQL tables using SQL calls.<br />
What you have to do is declare a TTable variable, create an instance, then with the TTable's FieldDefs property, add field definitions. Finally, you'll make a call to CreateTable, and your table will be created. Here's some example code:<br />
<pre>{ "Add" is the operative function here.
Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean);
}
procedure CreateATable(DBName, //Alias or path
TblName : String); //Table Name to Create
var
tbl : TTable;
begin
tbl := TTable.Create(Application);
with tbl do begin
Active := False;
DatabaseName := DBName;
TableName := TblName;
TableType := ttParadox;
with FieldDefs do begin
Clear;
Add('LastName', ftString, 30, False);
Add('FirstName', ftString, 30, False);
Add('Address1', ftString, 40, False);
Add('Address2', ftString, 40, False);
Add('City', ftString, 30, False);
Add('ST', ftString, 2, False);
Add('Zip', ftString, 10, False);
end;
{Add a Primary Key to the table}
with IndexDefs do begin
Clear;
Add('Field1Index', 'LastName;FirstName', [ixPrimary, ixUnique]);
end;
CreateTable; {Make the table}
end;
end;</pre>The procedure above makes a simple contact table, first by defining the fields to be included in the table, then creating a primary key. As you can see, it's a pretty straightforward procedure. One thing you can do is to change the TableType property setting to a variable that's passed as a parameter to the procedure so you can create DBase or even ASCII tables. Here's snippet of how you'd accomplish that:<br />
<pre>procedure CreateATable(DBName, //Alias or path
TblName : String); //Table Name to Create
TblType : TTableType); //ttDefault, ttParadox, ttDBase, ttASCII
var
tbl : TTable;
begin
tbl := TTable.Create(Application);
with tbl do begin
Active := False;
DatabaseName := DBName;
TableName := TblName;
TableType := TblType;
with FieldDefs do begin
Clear;
Add('LastName', ftString, 30, False);
Add('FirstName', ftString, 30, False);
Add('Address1', ftString, 40, False);
Add('Address2', ftString, 40, False);
Add('City', ftString, 30, False);
Add('ST', ftString, 2, False);
Add('Zip', ftString, 10, False);
end;
{Add a Primary Key to the table}
with IndexDefs do begin
Clear;
Add('Field1Index', 'LastName;FirstName', [ixPrimary, ixUnique]);
end;
CreateTable; {Make the table}
end;
end;</pre>Pretty simple, right? One thing you should note is that the TableType property is only used for desktop databases. It doesn't apply to SQL tables. <br />
Oh well, that's it in a nutshell. Have fun!iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-12350229611291299842011-07-07T08:43:00.002+07:002011-07-07T08:43:36.324+07:00How can I put a button on a form's caption bar?I've seen some programs that add text or buttons on the title bar of a form. How can I do this in Delphi?<br />
<br />
I got my first insight into solving this problem when I wrote a previous tip that covered rolling up the client area of forms so that only the caption bar showed. In my research for that tip, I came across the WMSetText message that is used for drawing on a form's canvas. I wrote a sample application to test drawing in the caption area. The only problem with my original code was that the button would disappear when I resized or moved the form.<br />
<br />
I turned to Delphi/Pascal guru Neil Rubenking for help. He pointed me in the direction of his book, Delphi Programming Problem Solver, which contains an example for doing this exact thing. The code below is an adaptation of the example in his book. The most fundamental difference between our examples is that I wanted to make a speedbutton with a bitmap glyph, and Neil actually drew a shape directly on the canvas. He also placed the button created in 16-bit Delphi on the left-hand side of the frame, and Win32 button placement was on the right. I wanted my buttons to be placed on the right for both versions, so I wrote appropriate code to handle that. The deficiency in my code was the lack of handlers for activation and painting in the non-client area of the form.<br />
<br />
One thing I'm continually discovering is that there is a very definitive structure in Windows &mdash a definite hierarchy of functions. I've realized that the thing that makes Windows programming at the API level difficult is the sheer number of functions in the API set. For those who are reluctant to dive into the WinAPI, think in terms of categories first, then narrow your search. You'll find that doing it this way will make your life much easier.<br />
<br />
What makes all of this work is Windows messages. The messages we're interested in here are not the usual Windows messages handled by plain-vanilla Windows apps, but are specific to an area of a window called the non-client area. The client area of a window is the part inside the border where most applications present information. The non-client area consists of the window's borders, caption bar, system menu and sizing buttons. The Windows messages that pertain to this area have the naming convention of WM_NCMessageType. Taking the name apart, 'WM' stands for Windows Message, 'NC' stands for Non-client area, and MessageType is the type of message being trapped. For example, WM_NCPaint is the paint message for the non-client area. Taking into account the hierarchical and categorical nature of the Windows API, nomenclature is a very big part of it; especially with Windows messages. If you look in the help file under messages, peruse through the list of messages and you will see the order that is followed.<br />
<br />
Let's look at a list of things that we need to consider to add a button to the title bar of a form:<br />
<br />
1. We need to have a function to draw the button.<br />
2. We'll have to trap drawing and painting events so that our button stays visible when the form activates, resizes or moves.<br />
3. We're dropping a button on the title bar, so we have to have a way of trapping for a mouse click on the button.<br />
<br />
I'll now discuss these topics, in the above order.<br />
<br />
Drawing a TRect as a Button<br />
<br />
You can't drop VCL objects onto a non-client area of a window, but you can draw on it and simulate the appearance of a button. In order to perform drawing in the title bar of a window, you have to do three very important things, in order:<br />
<br />
1. You must get the current measurements of the window and the size of the frame bitmaps so you know what area to draw in and how big to draw the rectangle.<br />
2. Then you have to define a TRect structure with the proper size and position within the title bar.<br />
3. Finally, you have to draw the TRect to appear as a button, then add any glyphs or text you might want to draw to the buttonface.<br />
<br />
All of this is accomplished in a single call. For this program we make a call to the DrawTitleButtonprocedure, which is listed below:<br />
<br />
procedure TTitleBtnForm.DrawTitleButton;<br />
var<br />
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}<br />
XFrame, {X and Y size of Sizeable area of Frame}<br />
YFrame,<br />
XTtlBit, {X and Y size of Bitmaps in caption}<br />
YTtlBit : Integer;<br />
begin<br />
{Get size of form frame and bitmaps in title bar}<br />
XFrame := GetSystemMetrics(SM_CXFRAME);<br />
YFrame := GetSystemMetrics(SM_CYFRAME);<br />
XTtlBit := GetSystemMetrics(SM_CXSIZE);<br />
YTtlBit := GetSystemMetrics(SM_CYSIZE);<br />
<br />
{$IFNDEF WIN32}<br />
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),<br />
YFrame - 1,<br />
XTtlBit + 2,<br />
YTtlBit + 2);<br />
<br />
{$ELSE} {Delphi 2.0 positioning}<br />
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br />
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),<br />
YFrame - 1,<br />
XTtlBit + 2,<br />
YTtlBit + 2)<br />
else<br />
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,<br />
XFrame + 2,<br />
XTtlBit + 2,<br />
YTtlBit + 2);<br />
{$ENDIF}<br />
<br />
<br />
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}<br />
try<br />
{Draw a button face on the TRect}<br />
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);<br />
bmap := TBitmap.Create;<br />
bmap.LoadFromFile('help.bmp');<br />
with TitleButton do<br />
{$IFNDEF WIN32}<br />
Canvas.Draw(Left + 2, Top + 2, bmap);<br />
{$ELSE}<br />
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br />
Canvas.Draw(Left + 2, Top + 2, bmap)<br />
else<br />
Canvas.StretchDraw(TitleButton, bmap);<br />
{$ENDIF}<br />
<br />
finally<br />
ReleaseDC(Self.Handle, Canvas.Handle);<br />
bmap.Free;<br />
Canvas.Handle := 0;<br />
end;<br />
end;<br />
<br />
Step 1 above is accomplished by making four calls to the WinAPI function GetSystemMetrics, asking the system for the width and height of the window that can be sized (SM_CXFRAME and SM_CYFRAME), and the size of the bitmaps contained on the title bar (SM_CXSIZE and SM_CYSIZE).<br />
<br />
Step 2 is performed with the Bounds function, which returns a TRect defined by the size and position parameters that are supplied to it. Notice that I used some conditional compiler directives here. This is because the size of the title bar buttons in Windows 95 and Windows 3.1 are different, so they have to be sized differently. And since I wanted to be able to compile this in either version of Windows, I used a test for the predefined symbol, WIN32, to see which version of Windows the program is compiled under. However, since the Windows NT UI is the same as Windows 3.1, it's necessary to grab further version information under the Win32 conditional to see if the Windows version is Windows NT. If so, we define the TRect to be just like the Windows 3.1 TRect.<br />
<br />
To perform Step 3, we make a call to the Buttons unit's DrawButtonFace to draw button features within the TRect that we defined. As added treat, I included code to draw a bitmap in the button. You'll see that I used a conditional compiler directive to draw the bitmap under different versions of Windows. I did this because the bitmap I used was 16x16 pixels, which might be too big for Win95 buttons. So I used StretchDraw under Win32 to stretch the bitmap to the size of the button.<br />
<br />
Trapping the Drawing and Painting Events<br />
<br />
You must make sure that the button will stay visible every time the form repaints itself. Painting occurs in response to activation and resizing, which fire off paint and text setting messages that will redraw the form. If you don't have a facility to redraw your button, you'll lose it every time a repaint occurs. So what we have to do is write event handlers which will perform their default actions and redraw our button when they fire off. The following four procedures handle the paint triggering and painting events:<br />
<br />
{Paint triggering events}<br />
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
procedure TForm1.FormResize(Sender: TObject);<br />
begin<br />
Perform(WM_NCACTIVATE, Word(Active), 0);<br />
end;<br />
<br />
{Painting events}<br />
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
procedure TForm1.WMSetText(var Msg : TWMSetText);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
Every time one of these events fires off, it makes a call to the DrawTitleButton procedure. This will ensure that our button is always visible on the title bar. Notice that we use the default handler OnResize on the form to force it to perform a WM_NCACTIVATE.<br />
<br />
Handling Mouse Clicks<br />
<br />
Now that we've got code that draws our button and ensures that it's always visible, we have to handle mouse clicks on the button. The way we do this is with two procedures. The first procedure tests to see if the mouse click was in the area of our button, then the second procedure actually performs the code execution associated with our button. Let's look at the code:<br />
<br />
{Mouse-related procedures}<br />
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);<br />
begin<br />
Inherited;<br />
{Check to see if the mouse was clicked in the area of the button}<br />
with Msg do<br />
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then<br />
Result := htTitleBtn;<br />
end;<br />
<br />
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);<br />
begin<br />
inherited;<br />
if (Msg.HitTest = htTitleBtn) then<br />
ShowMessage('You pressed the new button');<br />
end;<br />
<br />
The first procedure WMNCHitTest(var Msg : TWMNCHitTest) is a hit tester message to determine where the mouse was clicked in the non-client area. In this procedure we test if the point defined by the message was within the bounds of our TRect by using the PtInRect function. If the mouse click was performed in the TRect, then the result of our message is set to htTitleBtn, which is a constant that was declared as htSizeLast + 1. htSizeLast is a hit test constant generated by hit test events to test where the last hit occurred.<br />
<br />
The second procedure is a custom handler for a left mouse click on a button in the non-client area. Here we test if the hit test result was equal to htTitleBtn. If it is, we show a message. You can make any call you choose to at this point.<br />
<br />
Putting it All Together<br />
<br />
Let's look at the entire code in the form to see how it all works together:<br />
<br />
unit Capbtn;<br />
<br />
interface<br />
<br />
uses<br />
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,<br />
Forms, Dialogs, Buttons;<br />
<br />
type<br />
TTitleBtnForm = class(TForm)<br />
procedure FormResize(Sender: TObject);<br />
private<br />
TitleButton : TRect;<br />
procedure DrawTitleButton;<br />
{Paint-related messages}<br />
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;<br />
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;<br />
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;<br />
{Mouse down-related messages}<br />
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;<br />
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;<br />
function GetVerInfo : DWORD;<br />
end;<br />
<br />
var<br />
TitleBtnForm: TTitleBtnForm;<br />
<br />
const<br />
htTitleBtn = htSizeLast + 1;<br />
<br />
implementation<br />
{$R *.DFM}<br />
<br />
procedure TTitleBtnForm.DrawTitleButton;<br />
var<br />
bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}<br />
XFrame, {X and Y size of Sizeable area of Frame}<br />
YFrame,<br />
XTtlBit, {X and Y size of Bitmaps in caption}<br />
YTtlBit : Integer;<br />
begin<br />
{Get size of form frame and bitmaps in title bar}<br />
XFrame := GetSystemMetrics(SM_CXFRAME);<br />
YFrame := GetSystemMetrics(SM_CYFRAME);<br />
XTtlBit := GetSystemMetrics(SM_CXSIZE);<br />
YTtlBit := GetSystemMetrics(SM_CYSIZE);<br />
<br />
{$IFNDEF WIN32}<br />
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),<br />
YFrame - 1,<br />
XTtlBit + 2,<br />
YTtlBit + 2);<br />
<br />
{$ELSE} {Delphi 2.0 positioning}<br />
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br />
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),<br />
YFrame - 1,<br />
XTtlBit + 2,<br />
YTtlBit + 2)<br />
else<br />
TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,<br />
XFrame + 2,<br />
XTtlBit + 2,<br />
YTtlBit + 2);<br />
{$ENDIF}<br />
<br />
<br />
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}<br />
try<br />
{Draw a button face on the TRect}<br />
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);<br />
bmap := TBitmap.Create;<br />
bmap.LoadFromFile('help.bmp');<br />
with TitleButton do<br />
{$IFNDEF WIN32}<br />
Canvas.Draw(Left + 2, Top + 2, bmap);<br />
{$ELSE}<br />
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br />
Canvas.Draw(Left + 2, Top + 2, bmap)<br />
else<br />
Canvas.StretchDraw(TitleButton, bmap);<br />
{$ENDIF}<br />
<br />
finally<br />
ReleaseDC(Self.Handle, Canvas.Handle);<br />
bmap.Free;<br />
Canvas.Handle := 0;<br />
end;<br />
end;<br />
<br />
{Paint triggering events}<br />
procedure TTitleBtnForm.WMNCActivate(var Msg : TWMNCActivate);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
procedure TTitleBtnForm.FormResize(Sender: TObject);<br />
begin<br />
Perform(WM_NCACTIVATE, Word(Active), 0);<br />
end;<br />
<br />
{Painting events}<br />
procedure TTitleBtnForm.WMNCPaint(var Msg : TWMNCPaint);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
procedure TTitleBtnForm.WMSetText(var Msg : TWMSetText);<br />
begin<br />
Inherited;<br />
DrawTitleButton;<br />
end;<br />
<br />
{Mouse-related procedures}<br />
procedure TTitleBtnForm.WMNCHitTest(var Msg : TWMNCHitTest);<br />
begin<br />
Inherited;<br />
{Check to see if the mouse was clicked in the area of the button}<br />
with Msg do<br />
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then<br />
Result := htTitleBtn;<br />
end;<br />
<br />
procedure TTitleBtnForm.WMNCLButtonDown(var Msg : TWMNCLButtonDown);<br />
begin<br />
inherited;<br />
if (Msg.HitTest = htTitleBtn) then<br />
ShowMessage('You pressed the new button');<br />
end;<br />
<br />
function TTitleBtnForm.GetVerInfo : DWORD;<br />
var<br />
verInfo : TOSVERSIONINFO;<br />
begin<br />
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);<br />
if GetVersionEx(verInfo) then<br />
Result := verInfo.dwPlatformID;<br />
{Returns:<br />
VER_PLATFORM_WIN32s Win32s on Windows 3.1<br />
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95<br />
VER_PLATFORM_WIN32_NT Windows NT }<br />
end;<br />
<br />
end.<br />
<br />
Suggestions for Exploring<br />
<br />
You might want to play around with this code a bit to customize it to your own needs. For instance, if you want to add a bigger button, add pixels to the XTtlBit var. You can also mess around with creating a floating toolbar that is purely on the title bar. Also, now that you have a means of interrogating what's going on in the non-client area of the form, you might want to play around with the default actions taken with the other buttons like the System Menu button to perhaps display your own custom menu.<br />
<br />
Take heed, though: Playing around with Windows messages can be dangerous. Save your work constantly, and be prepared for some system crashes while you experiment.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-23380099636757556672011-07-07T08:42:00.000+07:002011-07-07T08:42:23.463+07:00Creating a Form Without a Title Bar<b>How can I create a form that doesn't have a caption, but can be re-sized? </b><br />
<hr /> <table bgcolor="#c0c0c0" border="1"><tbody>
<tr> <td width="100%"><span style="color: blue;">As they say, "There's more than one way to skin a cat," and I can't agree more as far as programming is concerned. Let me share a little anecdote with you...</span><span style="color: blue;">Being the "artistic dude" in my company, I'm always in search of new ways to present information to users. I do this by creating non-standard user interfaces (which I find rather boring), spicing them up with graphics and multimedia features. My philosophy centers around this question: Why should information retrieval be a boring task? Well, it shouldn't. And an extension to this question could be: Why do business programs have to all look the same? Well, they don't. So I choose to build "odd" business user interfaces. </span><br />
<span style="color: blue;">My latest designs have followed game interfacess that use a plethora of high-resolution graphics and captionless forms (this is where it all kicks in). In the past, I didn't need my forms to move anywhere. But as my interfaces have become more complex, I've had to start providing ways to move them. Unfortunately, the method that I employed in the original article here, didn't account for clicking only in a certain area on a form. You just click and hold the mouse button down anywhere on the form, and the form will move. Unfortunately, that isn't always the best solution.</span><br />
<span style="color: blue;">For instance, with one of my forms, I created a "pseudo" caption by aligning a TPanel at the top of the client area of my form. There's a bit more functionality built into the panel, but I wanted it to act very much like a regular caption: a click and drag would drag the form, and a double-click would maximize it. With that in mind, I set about writing the panel's click and drag method using what I originally wrote as a base. It didn't work. So doing a little research and asking a couple of questions around the newsgroups, Kerstin Thaler, a very helpful person, showed me a real cool method for implementing what I needed to do. Here it is:</span><br />
<pre>procedure TMainFrm.Panel1MouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
const
SC_DRAGMOVE = $F012;
begin
if Button = mbLeft then
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
end;</pre><span style="color: blue;">This is such incredibly easy code! Instead of overriding the default NC_HITTEST message handler, I could accomplish form movement from the MouseDown of my panel! Basically, all the method does is send a WM_SYSCOMMAND message to the form with the SC_DRAGMOVE constant to perform a drag move. Kerstin did say, that the $F012 isn't documented. But hey! the method works and it works well. So if you have a captionless form and want to move it by dragging from one of its child components, this is the way to do it!</span></td> </tr>
</tbody></table>Many folks would say, "Just set the BorderStyle of the form to <b>bsNone</b> and you'll remove the caption." However, there's a problem with that suggestion: Not only do you lose the caption bar, you lose the entire border, which means you can't resize the form. The only way to get around this is to go behind the scenes in Delphi. Fortunately, it's a relatively simple process. <br />
Delphi is not just ObjectPascal; it is also a very effective wrapper of the Windows API (Don't worry, we won't get into the Windows API too much in this article). In Windows, every window is created using one of two standard functions: <b>CreateWindow</b> and <b>CreateWindowEx</b>. <b>CreateWindow</b> makes a window with standard window styles, while <b>CreateWindowEx</b> is the same as CreateWindow, but you can add extended window styles to the window you want to create. (I encourage you to read through the help file for a thorough discussion of these two API calls since I won't be going into detail with these topics.) <br />
When a form is created in Delphi, a call is made to <b>CreateWindowEx</b> &mdash TForm's Create method is the wrapper function for this call &mdash and Create passes a record structure to <b>CreateWindowsEx</b> through a virtual method of TForm called <b>CreateParams</b>. <br />
<b>CreateParams</b> is a <b>virtual</b> method of TForm. This means you can override it which, in turn, means you can change the default style of a window when it's created to suit your particular needs. For our purposes, we want to eliminate the caption. That's easily done by changing the style bits of the LongInt <b>Style</b> field of the TCreateParams structure, the record that's passed to <b>CreateWindowEx</b>. Look at the code; we'll discuss particulars below: <br />
<pre>unit NoCap;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Buttons, BDE, DB;
type
TForm1 = class(TForm)
Button1 : TButton;
procedure Button1Click(Sender: TObject);
private
{Here's what we're overriding}
procedure CreateParams(VAR Params: TCreateParams); override;
procedure WMNCHitTest(VAR Msg: TWMNcHitTest); message WM_NCHITTEST;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.CreateParams(VAR Params: TCreateParams);
begin
Inherited CreateParams(Params);
WITH Params DO
Style := (Style OR WS_POPUP) AND (NOT WS_DLGFRAME);
{or... Style := Style + WS_POPUP - WS_DLGFRAME; which is the
equivalent to the above statement}
end;
procedure TForm1.WMNCHitTest(var msg: TWMNCHitTest);
begin
inherited;
if (msg.Result = htClient) then
msg.Result := htCaption;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
end.</pre>Notice in the line in <b>CreateParams</b> where I set the Style for the form: <code>Style := (Style OR WS_POPUP) AND (NOT WS_DLGFRAME);</code>. My first bit manipulation is Style OR WS_POPUP. This means <i>give me the default style bits and make the window a regular pop-up window with a resizeable border</i>. The second portion says <i>don't include a dialog frame</i>. With respect to this, the WS_DLGFRAME will produce a frame typical of dialog boxes. By masking it out, you remove the title bar. WS_POPUP ensures you have a resizeable border with which to work. <br />
What about the WMNCHitTest message handler? Well, if you have a form with no title bar, you have absolutely no way to move it, because by convention, forms are moved by dragging the title bar. By trapping a mouse hit with the WM_NCHITTEST message and changing the default behavior of the mouse hit, you can allow dragging of the form from the client area. <br />
Read through the Windows API help and look at all the style bits you can set. Play with different combinations to see what you get.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-26568663355453736482011-07-07T08:41:00.000+07:002011-07-07T08:41:20.680+07:00How to Flash the Taskbar button of an Application<div class="subTitle"><b>Notifying the user that attention to your program is needed by flashing the taskbar button, the window, or both.</b></div><hr /> If the application you are building is targeted at Windows 98 or above, you can use the API call FlashWindowEx and pass it a FlashWInfo structure. If you are targeting Windows 95 your options are more limited, and you have to use a timer to achieve the desired result.<br />
<u><strong>FlashWindowEx</strong></u><br />
A TFlashWInfo structure is needed to hold the information Windows needs to do its job when you make the API call. Luckily all the work has been done for you, and Delphi already knows about the structure. It is declared in Delphi like this:<br />
<pre><b>type</b>
TFlashWInfo = <b>record</b>
cbSize : LongInt;
hWnd : LongInt;
dwFlags : LongInt;
uCount : LongInt;
dwTimeout : LongInt;
<b>end</b>;</pre>All you need to do is to populate the record and call the API function. For this example I have placed both in the OnClick event of a button, but you can of course locate them wherever suits you:<br />
<pre><b>procedure</b> TForm1.Button1Click(Sender: TObject);
<b>var</b>
FWinfo: TFlashWInfo;
<b>begin</b>
FWinfo.cbSize := 20;
FWinfo.hwnd := Application.Handle; // Handle of Window to flash
FWinfo.dwflags := FLASHW_ALL;
FWinfo.ucount := 10; // number of times to flash
FWinfo.dwtimeout := 0; // speed in ms, 0 default blink cursor rate
FlashWindowEx(FWinfo); // make it flash!
<b>end</b>;</pre>Note that the flag shown against the dwflags property determines what the call does with the flashing, and the following constants are defined:<br />
<pre>FLASHW_STOP = 0 // Stop flashing
FLASHW_CAPTION = 1 // Flash the window caption
FLASHW_TRAY = 2 // Flash the taskbar button
FLASHW_ALL = 3 // Flash both the window caption and taskbar button
FLASHW_TIMER = 4 // Flash continuously, until the FLASHW_STOP flag is set
FLASHW_TIMERNOFG = 5 // Flash continuously until the window
// comes to the foreground</pre>This should work fine with Windows 98 and above. If you want to work with Windows 95, however, you will need to take a different approach:<br />
<u><strong>FlashWindow</strong></u><br />
Under Windows 95 (and Delphi versions 3 and below which do not include the appropriate API wrapper) a different approach is needed. With this operating system the FlashWindowEx API call does not exist, and you need to use FlashWindow instead. (The FlashWindow call will work under later operating systems as well.)<br />
The problem with FlashWindow is that it only works once, so to achieve the required flashing button it is necessary to use a system timer. This, of course, uses up valuable resources - but it does achieve the desired effect.<br />
For the purposes of this example you need to create a form and drop a Timer and a Button onto it. Then select the Timer and double click the OnTimer event to create the event handler. Then add the following code:<br />
<pre><b>procedure</b> TForm1.Timer1Timer(Sender: TObject);
<b>begin</b>
FlashWindow(Application.Handle, True);
<b>end</b>;</pre>Next, you need to start the flashing. To do this simply use the button OnClick event to set the Enabled property of the Timer to True. In this example I have used the button event to toggle the flashing on or off:<br />
<pre><b>procedure</b> TForm1.Button1Click(Sender: TObject);
<b>begin</b>
Timer1.Enabled := not Timer1.Enabled;
<b>end</b>;</pre>So there you have it. Two different ways to achieve the same thing.<br />
<br />
-------------------------------------------------------------------------------------------<br />
<br />
<h4><span style="color: red;"><u><strong>Update</strong></u></span></h4>Within minutes of posting this example Simon Clayton got in touch to suggest a way of causing the flashing ONLY if the application is not the currently active one. Over to Simon:<br />
I've done it like this:<br />
<pre><b>procedure</b> TForm1.Timer1Timer(Sender: TObject);
<b>begin</b>
<b>if</b> (GetForeGroundWindow()<>Form1.Handle) <b>then</b>
<b>begin</b>
FWinfo.cbSize := 20;
FWinfo.hwnd := Application.Handle;
FWinfo.dwflags := FLASHW_ALL;
FWinfo.ucount := 5;
FWinfo.dwtimeout := 0;
Flashing := True;
FlashWindowEx(FWinfo);
<b>end</b>
<b>else</b> <b>if</b> (Flashing) <b>then</b>
<b>begin</b>
FWinfo.cbSize := 20;
FWinfo.hwnd := Application.Handle;
FWinfo.dwflags := FLASHW_STOP;
FWinfo.ucount := 0;
FWinfo.dwtimeout := 0;
FlashWindowEx(FWinfo);
Flashing := false;
<b>end</b>;
<b>end</b>;</pre>I have also put some code in the Form's onPaint event to stop the flashing:<br />
<pre><b>procedure</b> TForm1.FormPaint(Sender: TObject);
<b>begin</b>
<b>if</b> (Flashing) <b>then</b>
<b>begin</b>
FWinfo.cbSize := 20;
FWinfo.hwnd := Application.Handle;
FWinfo.dwflags := FLASHW_STOP;
FWinfo.ucount := 0;
FWinfo.dwtimeout := 0;
FlashWindowEx(FWinfo);
<b>end</b>;
<b>end</b>;</pre>The only problem I have now to solve is that if I am using an app on my second monitor and the form is on top on my first monitor then the onPaint event doesn't seem to get called when I switch back to the application which means that the flashing carries on - something I've noticed is a problem in MS Instant Messenger sometimes anyway.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-74202020649285374022011-07-07T08:39:00.002+07:002011-07-07T08:39:47.088+07:00Launching a Program at Windows StartupThere are a few programs installed on my system that launch when Windows starts, but don't have shortcuts in my Startup folder. Is there some trick that I'm missing here?<br />
<br />
Are you kiddin'? That capability isn't clearly documented anywhere? Okay, okay, enough of the facetiousness... In actuality, it is a bit of a trick to get a program to do this (primarily because it's not something that's very well-documented), but it's not trickery of any sort that would prevent you from being able to program this yourself. All it involves is writing to one of two paths in the Windows registry under the HKEY_LOCAL_MACHINE root key:<br />
<br />
1. Software\Microsoft\Windows\CurrentVersion\RunOnce -or-<br />
2. Software\Microsoft\Windows\CurrentVersion\Run<br />
<br />
As you've probably surmised, writing an entry to the "RunOnce" key will make it so your program only launches after the next shutdown and startup of Windows. Writing an entry to the "Run" key will make your program launch each time Windows is started.<br />
<br />
Here's a quick procedure that'll do either action for you. We'll discuss it after I list the code:<br />
<br />
{=====================================================================<br />
The following procedure instructs Windows at startup to execute your<br />
program. Here's a summary of the formal params:<br />
<br />
WindowTitle : Title of the Window of your program. Note that this is<br />
actually a superfluous parameter, and can be any value<br />
you want. But for convention's sake, and because the<br />
registry entry expects a value, you have to provide it.<br />
<br />
CommandLn : This is the fully qualified path and executable name of<br />
your program (e.g. 'C:\MyProgams\MyProgam.exe.' If you<br />
have any command line parameters, you include them in<br />
this string as well.<br />
<br />
RunOnlyOnce : Setting this to true makes the program only launch just<br />
once after you write to the registry. Once it's launched,<br />
Windows will delete its entry from the Run path in the<br />
registry. Set it to False if you want your program to<br />
always launch when Windows starts up.<br />
=====================================================================}<br />
procedure RunOnStartup(WindowTitle, <br />
CommandLn : String; <br />
RunOnlyOnce: Boolean);<br />
var<br />
RegIniFile : TRegIniFile;<br />
begin<br />
RegIniFile := TRegIniFile.Create('');<br />
with RegIniFile do begin<br />
RootKey := HKEY_LOCAL_MACHINE;<br />
if RunOnlyOnce then<br />
RegIniFile.WriteString('Software\Microsoft\Windows\' +<br />
'CurrentVersion\RunOnce'#0,<br />
WindowTitle, CommandLn)<br />
else<br />
RegIniFile.WriteString('Software\Microsoft\Windows\' +<br />
'CurrentVersion\Run'#0,<br />
WindowTitle, CommandLn);<br />
Free;<br />
end;<br />
end;<br />
<br />
Notice that the RegIniFile instance variable above is of type TRegIniFile, as opposed to TRegistry. TRegIniFile is a descendant class of TRegistry and inherits all its methods and properties. And in addition to all that, it adds comparable methods of TIniFile, the tried and true Windows 3.1 class. This allows us to treat the registry like an INI file, which is far easier to work with than accessing the registry through TRegistry. This is one of the things I just love about Delphi! Want to make it simple? Subclass and extend a class' functionality!<br />
Employing the Procedure<br />
<br />
So where should you employ this? The most likely place is to use the procedure with system tray applications that you always want to run when Windows starts up. Personally, I make a call to the function in the OnClose event of the main form of my application. That way, I always know that even if Windows is shutdown, my program will make sure that its Run or RunOnce entry is written to the Registry.<br />
<br />
Another place you might want to use this procedure is with readme or help files that accompany a program that you install on another computer, ala Microsoft Intellipoint Mouse help...<br />
<br />
In any case, I'm sure you'll find a good use for it.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-66311976345181234402011-07-07T08:26:00.001+07:002011-07-07T10:09:28.371+07:00Creating Shaped Forms<div class="subTitle"><b>Cool Bitmap shaped forms the easy way</b></div><hr />Hey! Bored with rectangular windows? HERE'S THE CODE to make any shape you want based on a bitmap picture. How to do it:<br />
1. First, make or choose any background bitmap you want your form to have. Then fill areas you want to go transparent with a distinct color (In this example, it is white). NOTE: The bitmap's size must be the actual size you want on your form. No stretching in Delphi will work.<br />
<br />
2. In Delphi, add a TImage(Image1) component on the form. Choose your bitmap and put the component where you want it. Autosize must be true. Other visual components must be on top of the "visible" part of the picture so that they will be seen.<br />
<br />
3. Add the following code (...I mean short code) to your FormCreate procedure. I know I should have made a component for it so that no code would be needed. But just to show you how, I guess this would suffice.<br />
<br />
<b>procedure</b> TForm1.FormCreate(Sender: TObject);<br />
<b>const</b><br />
// Image Color <b>to</b> be made transparent<br />
MASKCOLOR = clWhite;<br />
<br />
// Cutting adjustments<br />
ADJ_TOP = 22;{TitleBar}<br />
ADJ_BOTTOM = 22 ;{TitleBar}<br />
ADJ_LEFT = 3;{Border}<br />
ADJ_RIGHT = 3;{Border}<br />
<b>var</b><br />
ShowRegion,CutRegion: HRgn;<br />
y,x1,x2:integer;<br />
PixelColor:TColor;<br />
<b>begin</b><br />
<br />
ShowRegion:=CreateRectRgn(Image1.Left+ADJ_LEFT,Image1.Top+ADJ_TOP,<br />
Image1.Left+Image1.Width+ADJ_RIGHT,Image1.Top+Image1.Height+ADJ_BOTTOM);<br />
<br />
// Cut the parts whose color <b>is</b> equal <b>to</b> MASKCOLOR by rows<br />
<b>for</b> y:=0 <b>to</b> Image1.Picture.Bitmap.Height-1 <b>do</b><br />
<b>begin</b><br />
x1:=0; // starting point of cutting<br />
x2:=0; // end point of cutting<br />
<b>repeat</b><br />
PixelColor:=Image1.Picture.Bitmap.Canvas.Pixels[x2,y];<br />
// the above will return -1 <b>if</b> x2 reached beyond the image<br />
<b>if</b> (PixelColor=MaskColor) <b>then</b><br />
Inc(x2)<br />
<b>else</b><br />
<b>begin</b><br />
//do following if pixel reached beyond image or if color of pixel is not MaskColor<br />
<b>if</b> x1 <> x2 <b>then</b><br />
<b>begin</b><br />
// Create the region to be cut. The region will be one line of pixels/a pixel with color of // MaskColor<br />
CutRegion:=CreateRectRgn(<br />
X1+Image1.Left+ADJ_LEFT ,<br />
Y+Image1.Top+ADJ_TOP,<br />
X2+Image1.Left+ADJ_RIGHT ,<br />
Y+Image1.Top+ADJ_TOP+1);<br />
<br />
<b>try</b><br />
CombineRgn(ShowRegion,ShowRegion,CutRegion,RGN_DIFF);<br />
// RGN_DIFF will get the difference of ShowRegion<br />
<b>finally</b><br />
DeleteObject(CutRegion);<br />
<b>end</b>;<br />
<b>end</b>;<br />
<br />
Inc(x2);<br />
x1:=x2;<br />
<b>end</b>;<br />
<b>until</b> PixelColor=-1;<br />
<b>end</b>;<br />
<br />
// Set the window to have the above defined region<br />
SetWindowRgn(Form1.Handle,ShowRegion,True);<br />
// NOTE : Do not free close/delete ShowRegion because it will become owned<br />
// by the operating system<br />
<br />
// You can manually disable the showing of the whole<br />
//form while dragging, with the following line but<br />
// just leave it since it is dependent on your<br />
// windows settings. Some people may want to have their<br />
// windows show its contents while dragging.<br />
<br />
// SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 0, nil, 0); {Disable drag showing}<br />
// SystemParametersInfo(SPI_SETDRAGFULLWINDOWS, 1, nil, 0); {Enable drag showing}<br />
<b>end</b>;<br />
<br />
NOW FOR THE FORM DRAGGING PART <br />
<br />
1. Add this line to the private declarations of your Form:<br />
<pre><b>procedure</b> WMNCHitTest(var Msg: TWMNCHitTest); <b>message</b> wm_NCHitTest;</pre>2. In the implementation part. Add the following (assuming your Form name is Form1):<br />
<b>procedure</b> TForm1.WMNCHitTest(var Msg: TWMNCHitTest);<br />
<b>begin</b><br />
<b>inherited</b>;<br />
<b>if</b> Msg.Result = htClient <b>then</b><br />
Msg.Result := htCaption;<br />
<b>end</b>;<br />
<br />
Also, add a button to close the form because the title bar cannot be seen. That's all!<br />
<br />
<br />
<br />
=============================================================<br />
<br />
<br />
This article comes thanks to Gerard Oei who provided the Delphi source code.<br />
We have already done a tutorial on how to create <a href="http://www.delphi-central.com/wierd.aspx">non-rectangular windows</a>. This tutorial shows how to create a form that is shaped around a bitmap. Like the previous tutorial it uses the <strong>SetWindowRGN</strong> function. The clever part here is how the region is created. <br />
<h2>Shaping the Form</h2>I will not explain in detail how the code works because I think it will be easier to read the code and let the comments explain what is happening.<br />
As an overview on the form you should place a TImage and set its picture property to be the image that you would like the form to be shaped around. At design time it should look like the following image: <br />
<center><img alt="Delphi 7" src="http://www.delphi-central.com/Images/Delphi7.gif" /></center> The main part of the code can be found in the function <strong>CreateRegion</strong> which uses the API functions <strong>CreateRectRGN</strong> and <strong>CombineRGN</strong> to great affect. CreateRegion is then called from the form's constructor to shape the form accordingly.<br />
<h2>The Sample Code</h2>What follows is the Delphi code for shaping the window. You can also download the code at the bottom of this tutorial.<br />
<pre><span style="color: red;"><b>function</b></span> TForm1<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>CreateRegion<span style="color: blue;"><b>(</b></span>Bmp<span style="color: blue;"><b>:</b></span> TBitmap<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>:</b></span> THandle<span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>var</b></span>
X<span style="color: blue;"><b>,</b></span> Y<span style="color: blue;"><b>,</b></span> StartX<span style="color: blue;"><b>:</b></span>Integer<span style="color: blue;"><b>;</b></span><em><span style="color: green;">
</span></em>Excl<span style="color: blue;"><b>:</b></span> THandle<span style="color: blue;"><b>;</b></span> Row<span style="color: blue;"><b>:</b></span> PRGBArray<span style="color: blue;"><b>;</b></span>
TransparentColor<span style="color: blue;"><b>:</b></span> TRGBTriple<span style="color: blue;"><b>;</b></span><span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// Change the format so we know how to compare </i></span>
<span style="color: green;"><i>// the colors </i></span>
Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>PixelFormat <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> pf24Bit<span style="color: blue;"><b>;
</b></span>
<span style="color: green;"><i>// Create a region of the whole bitmap </i></span>
<span style="color: green;"><i>// later we will take the transparent </i></span> <span style="color: green;"><i>
// bits away</i></span> Result <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> CreateRectRGN<span style="color: blue;"><b>(</b></span><span style="color: brown;">0</span><span style="color: blue;"><b>,</b></span> <span style="color: brown;">0</span><span style="color: blue;"><b>,</b></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Width<span style="color: blue;"><b>,</b></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Height<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: green;"><i>// Loop down the bitmap </i></span> <span style="color: red;"><b>
for</b></span> Y <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> <span style="color: brown;">0</span> <span style="color: red;"><b>to</b></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Height <span style="color: blue;">-</span> <span style="color: brown;">1</span> <span style="color: red;"><b>do</b></span>
<span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// Get the current row of pixels</i></span> Row <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Scanline<span style="color: blue;"><b>[</b></span>Y<span style="color: blue;"><b>]</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: green;"><i>// If its the first get the transparent</i></span> <span style="color: green;"><i>// color, it must be the top left pixel</i></span> <span style="color: red;"><b>if</b></span> Y <span style="color: blue;">=</span> <span style="color: brown;">0</span> <span style="color: red;"><b>then</b></span>
<span style="color: red;"><b>begin</b></span>
TransparentColor <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> Row<span style="color: blue;"><b>[</b></span><span style="color: brown;">0</span><span style="color: blue;"><b>]</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: green;"><i>// Reset StartX (-1) to indicate we have</i></span> <span style="color: green;"><i>// not found a transparent area yet</i></span> StartX <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> <span style="color: blue;">-</span><span style="color: brown;">1</span><span style="color: blue;"><b>;</b></span>
<span style="color: green;"><i>// Loop across the row</i></span> <span style="color: red;"><b>for</b></span> X <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> <span style="color: brown;">0</span> <span style="color: red;"><b>to</b></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Width <span style="color: red;"><b>do</b></span>
<span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// Check for transparency by comparing the color</i></span> <span style="color: red;"><b>if</b></span><span style="color: blue;"><b>(</b></span>X <span style="color: blue;"><</span><span style="color: blue;">></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Width<span style="color: blue;"><b>)</b></span> <span style="color: red;"><b>and</b></span>
<span style="color: blue;"><b>(</b></span>Row<span style="color: blue;"><b>[</b></span>X<span style="color: blue;"><b>]</b></span><span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtRed <span style="color: blue;">=</span> TransparentColor<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtRed<span style="color: blue;"><b>)</b></span> <span style="color: red;"><b>and</b></span>
<span style="color: blue;"><b>(</b></span>Row<span style="color: blue;"><b>[</b></span>X<span style="color: blue;"><b>]</b></span><span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtGreen <span style="color: blue;">=</span> TransparentColor<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtGreen<span style="color: blue;"><b>)</b></span> <span style="color: red;"><b>and</b></span>
<span style="color: blue;"><b>(</b></span>Row<span style="color: blue;"><b>[</b></span>X<span style="color: blue;"><b>]</b></span><span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtBlue <span style="color: blue;">=</span> TransparentColor<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>rgbtBlue<span style="color: blue;"><b>)</b></span> <span style="color: red;"><b>then</b></span>
<span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// We have (X <> Bmp.Width) in the clause so that</i></span> <span style="color: green;"><i>// when we go past the end of the row we we can</i></span> <span style="color: green;"><i>// exclude the remaining transparent area (if any)</i></span> <span style="color: green;"><i>// If its transparent and the previous wasn't</i></span> <span style="color: green;"><i>// remember were the transparency started</i></span> <span style="color: red;"><b>if</b></span> StartX <span style="color: blue;">=</span> <span style="color: blue;">-</span><span style="color: brown;">1</span> <span style="color: red;"><b>then</b></span>
<span style="color: red;"><b>begin</b></span>
StartX <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> X<span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span>
<span style="color: red;"><b>else</b></span>
<span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// Its not transparent</i></span> <span style="color: red;"><b>if</b></span> StartX <span style="color: blue;">></span> <span style="color: blue;">-</span><span style="color: brown;">1</span> <span style="color: red;"><b>then</b></span>
<span style="color: red;"><b>begin</b></span>
<span style="color: green;"><i>// If previous pixels were transparent we</i></span> <span style="color: green;"><i>// can now exclude the from the region</i></span> Excl <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> CreateRectRGN<span style="color: blue;"><b>(</b></span>StartX<span style="color: blue;"><b>,</b></span> Y<span style="color: blue;"><b>,</b></span> X<span style="color: blue;"><b>,</b></span> Y <span style="color: blue;">+</span> <span style="color: brown;">1</span><span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>try</b></span>
<span style="color: green;"><i>// Remove the exclusion from our original </i></span><span style="color: green;"><i>region</i></span> CombineRGN<span style="color: blue;"><b>(</b></span>Result<span style="color: blue;"><b>, </b></span>Result<span style="color: blue;"><b>,</b></span> Excl<span style="color: blue;"><b>,</b></span> RGN_DIFF<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: green;"><i>// Reset StartX so we can start searching</i></span> <span style="color: green;"><i>// for the next transparent area</i></span> StartX <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> <span style="color: blue;">-</span><span style="color: brown;">1</span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>finally</b></span>
DeleteObject<span style="color: blue;"><b>(</b></span>Excl<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;
</b></span><span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span> <span style="color: red;"><b>
end</b></span><span style="color: blue;"><b>;
</b></span>
<span style="color: red;"><b>procedure</b></span> TForm1<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>FormCreate<span style="color: blue;"><b>(</b></span>Sender<span style="color: blue;"><b>:</b></span> TObject<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span> <span style="color: red;"><b>
var</b></span>
Bmp<span style="color: blue;"><b>:</b></span> TBitmap<span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>begin</b></span>
Bmp <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> TBitmap<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Create<span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>try</b></span>
<span style="color: green;"><i>// We use a TImage to hold the bitmap so that </i></span>
<span style="color: green;"><i>// we can see how the form will look at design</i></span> <span style="color: green;"><i>// time</i></span> Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Assign<span style="color: blue;"><b>(</b></span>Image1<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Picture<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span> FRegion <span style="color: blue;"><b>:</b></span><span style="color: blue;">=</span> CreateRegion<span style="color: blue;"><b>(</b></span>Bmp<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span> SetWindowRGN<span style="color: blue;"><b>(</b></span>Handle<span style="color: blue;"><b>,</b></span> FRegion<span style="color: blue;"><b>,</b></span> True<span style="color: blue;"><b>)</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>finally</b></span>
Bmp<span style="color: blue;"><b><span style="color: blue;"><b>.</b></span></b></span>Free<span style="color: blue;"><b>;</b></span><span style="color: red;"><b> end</b></span><span style="color: blue;"><b>;</b></span>
<span style="color: red;"><b>end</b></span><span style="color: blue;"><b>;</b></span></pre><h2>Conclusion</h2>When the application is run the form should now take the shape of the bitmap, as shown in the following screen shot<br />
<center><img src="http://www.delphi-central.com/Images/ShapedDelphi7.gif" /></center> Once again I would like to say a big thank you to <strong>Gerard Oei</strong> for providing the code to this article. You can download the <a href="http://www.delphi-central.com/downloads/BitmapShapedForm.zip">source code here</a>. <br />
<br />
Source : http://www.delphi-central.com/BitmapShapedForm.aspxiwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-91619171653651712022011-07-06T19:02:00.000+07:002011-07-06T19:02:39.280+07:00Single application instanceLimiting an application to start just once per machine is usually required when an<br />
external resource such as a Comport is accessed. This feature is achieved by allocation<br />
of a global variable, such as a mutex. <br />
<h2>The original version</h2>Be the original application <b>MyApp.dpr</b> generated by Delphi as dpr file. <pre>program MyApp;
uses
Windows,Forms,
MyApp1 in 'MyApp1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
</pre><h2>The single instance version</h2>Do the following changes ( in bold ): <pre>program MyApp;
uses
Windows,Forms,
MyApp1 in 'MyApp1.pas' {Form1};
<b>
var
Mutex : THandle;</b>
{$R *.RES}
begin
<b>Mutex := CreateMutex(nil, True, 'MyAppName');
if (Mutex <> 0) and (GetLastError = 0) then
begin</b>
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
<b> if Mutex <> 0 then
CloseHandle(Mutex);
end;</b>
end.
</pre>The application will only start once at a time without any further notice.<br />
Any further attempts will be defeated.<br />
<br />
A little addition, perhaps as modal notice, could notify the user<br />
that only one is allowed at a time.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0tag:blogger.com,1999:blog-6720576332896486180.post-42894453068986944412011-07-04T22:13:00.000+07:002011-07-04T22:13:14.845+07:00how to make "X" minimize the form?try this.. works fine for me..<br />
<br />
<br />
<br />
unit Unit1;<br />
<br />
interface<br />
<br />
uses<br />
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br />
StdCtrls;<br />
<br />
type<br />
TForm1 = class(TForm)<br />
Button1: TButton;<br />
procedure Button1Click(Sender: TObject);<br />
<div style="color: #3d85c6;">private</div><div style="color: #3d85c6;">{ Private declarations }</div><div style="color: blue;"><b>procedure WMSyscommand(Var msg: TWmSysCommand); message WM_SYSCOMMAND;</b></div>public<br />
{ Public declarations }<br />
end;<br />
<br />
var<br />
Form1: TForm1;<br />
<br />
implementation<br />
<br />
{$R *.DFM}<br />
<br />
<br />
<div style="color: blue;">procedure TForm1.WMSyscommand(Var msg: TWmSysCommand); //message WM_SYSCOMMAND;</div><div style="color: blue;">begin</div><div style="color: blue;">if (msg.cmdtype and $FFF0) = SC_CLOSE then</div><div style="color: blue;">Application.Minimize</div><div style="color: blue;">else</div><div style="color: blue;">inherited;</div><div style="color: blue;">end;</div><br />
<br />
//user can close if use windows shutdown,logoff or click the "close button in your app"<br />
procedure TForm1.Button1Click(Sender: TObject);<br />
begin<br />
close;<br />
end;<br />
<br />
end.iwan RFIDhttp://www.blogger.com/profile/13124438055693410697noreply@blogger.com0