tag:blogger.com,1999:blog-52325825845759654662024-02-20T04:07:27.395-08:00Delphi Knowledge BaseMore than 2000+ Delphi articles.Unknownnoreply@blogger.comBlogger2727125tag:blogger.com,1999:blog-5232582584575965466.post-17772064127766553972013-04-10T07:54:00.001-07:002013-04-10T07:54:51.380-07:00Monitoring System Shell Changes using Delphi<br />
<pre style="background-color: white; color: #333333; font-size: 12px; line-height: 18px; margin-bottom: 1.5em; margin-left: 3em; margin-top: 1.5em; padding: 0px; text-decoration: inherit; white-space: pre-wrap;"><h2 style="color: inherit; font-size: 12px; line-height: 1.3; margin: 1.5em 0px; padding: 0px; text-decoration: inherit;">
<span style="font-family: Courier New, Courier, monospace;">TSHChangeNotify</span></h2>
<span style="font-family: Courier New, Courier, monospace;">
<b>unit</b> SHChangeNotify;
<i><span style="color: navy;">{$IFNDEF VER80}</span></i> <i><span style="color: navy;">{$IFNDEF VER90}</span></i> <i><span style="color: navy;">{$IFNDEF VER93}</span></i>
<i><span style="color: navy;">{$DEFINE Delphi3orHigher}</span></i>
<i><span style="color: navy;">{$ENDIF}</span></i> <i><span style="color: navy;">{$ENDIF}</span></i> <i><span style="color: navy;">{$ENDIF}</span></i>
<i><span style="color: navy;">//*************************************************************</span></i>
<i><span style="color: navy;">//*************************************************************</span></i>
<i><span style="color: navy;">// TSHChangeNotify component by Elliott Shevin shevine@aol.com</span></i>
<i><span style="color: navy;">// vers. 3.0, October 2000</span></i>
<i><span style="color: navy;">//</span></i>
<i><span style="color: navy;">// See the README.TXT file for revision history.</span></i>
<i><span style="color: navy;">//</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* I owe this component to James Holderness, who described the</span></i>
<i><span style="color: navy;">//* use of the undocumented Windows API calls it depends upon,</span></i>
<i><span style="color: navy;">//* and Brad Martinez, who coded a similar function in Visual</span></i>
<i><span style="color: navy;">//* Basic. I quote here from Brad's expression of gratitude to</span></i>
<i><span style="color: navy;">//* James:</span></i>
<i><span style="color: navy;">//* Interpretation of the shell's undocumented functions</span></i>
<i><span style="color: navy;">//* SHChangeNotifyRegister (ordinal 2) and SHChangeNotifyDeregister</span></i>
<i><span style="color: navy;">//* (ordinal 4) would not have been possible without the</span></i>
<i><span style="color: navy;">//* assistance of James Holderness. For a complete (and probably</span></i>
<i><span style="color: navy;">//* more accurate) overview of shell change notifcations,</span></i>
<i><span style="color: navy;">//* please refer to James' "Shell Notifications" page at</span></i>
<i><span style="color: navy;">//* http://www.geocities.com/SiliconValley/4942/</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* This component will let you know when selected events</span></i>
<i><span style="color: navy;">//* occur in the Windows shell, such as files and folders</span></i>
<i><span style="color: navy;">//* being renamed, added, or deleted. (Moving an item yields</span></i>
<i><span style="color: navy;">//* the same results as renaming it.) For the complete list</span></i>
<i><span style="color: navy;">//* of events the component can trap, see Win32 Programmer's</span></i>
<i><span style="color: navy;">//* reference description of the SHChangeNotify API call.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* Properties:</span></i>
<i><span style="color: navy;">//* MessageNo: the Windows message number which will be used to signal</span></i>
<i><span style="color: navy;">//* a trapped event. The default is WM_USER (1024); you may</span></i>
<i><span style="color: navy;">//* set it to some other value if you're using WM_USER for</span></i>
<i><span style="color: navy;">//* any other purpose.</span></i>
<i><span style="color: navy;">//* TextCase: tcAsIs (default), tcLowercase, or tcUppercase, determines</span></i>
<i><span style="color: navy;">//* whether and how the Path parameters passed to your event</span></i>
<i><span style="color: navy;">//* handlers are case-converted.</span></i>
<i><span style="color: navy;">//* HardDriveOnly: when set to True, the component monitors only local</span></i>
<i><span style="color: navy;">//* hard drive partitions; when set to False, monitors the</span></i>
<i><span style="color: navy;">//* entire file system.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* Methods:</span></i>
<i><span style="color: navy;">//* Execute: Begin monitoring the selected shell events.</span></i>
<i><span style="color: navy;">//* Stop: Stop monitoring.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* Events:</span></i>
<i><span style="color: navy;">//* The component has an event corresponding to each event it can</span></i>
<i><span style="color: navy;">//* trap, e.g. OnCreate, OnMediaInsert, etc.</span></i>
<i><span style="color: navy;">//* Each event handler is passed either three or four parameters--</span></i>
<i><span style="color: navy;">//* Sender=this component.</span></i>
<i><span style="color: navy;">//* Flags=the value indentifying the event that triggered the handler,</span></i>
<i><span style="color: navy;">//* from the constants in the SHChangeNotify help. This parameter</span></i>
<i><span style="color: navy;">//* allows multiple events to share handlers and still distinguish</span></i>
<i><span style="color: navy;">//* the reason the handler was triggered.</span></i>
<i><span style="color: navy;">//* Path1, Path2: strings which are the paths affected by the shell</span></i>
<i><span style="color: navy;">//* event. Whether both are passed depends on whether the second</span></i>
<i><span style="color: navy;">//* is needed to describe the event. For example, OnDelete gives</span></i>
<i><span style="color: navy;">//* only the name of the file (including path) that was deleted;</span></i>
<i><span style="color: navy;">//* but OnRenameFolder gives the original folder name in Path1</span></i>
<i><span style="color: navy;">//* and the new name in Path2.</span></i>
<i><span style="color: navy;">//* In some cases, such as OnAssocChanged, neither Path parameter</span></i>
<i><span style="color: navy;">//* means anything, and in other cases, I guessed, but we always</span></i>
<i><span style="color: navy;">//* pass at least one.</span></i>
<i><span style="color: navy;">//* Each time an event property is changed, the component is reset to</span></i>
<i><span style="color: navy;">//* trap only those events for which handlers are assigned. So assigning</span></i>
<i><span style="color: navy;">//* an event handler suffices to indicate your intention to trap the</span></i>
<i><span style="color: navy;">//* corresponding shell event.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* There is one more event: OnEndSessionQuery, which has the same</span></i>
<i><span style="color: navy;">//* parameters as the standard Delphi OnCloseQuery (and can in fact</span></i>
<i><span style="color: navy;">//* be your OnCloseQuery handler). This component must shut down its</span></i>
<i><span style="color: navy;">//* interception of shell events when system shutdown is begun, lest</span></i>
<i><span style="color: navy;">//* the system fail to shut down at the user's request.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* Setting CanEndSession (same as CanClose) to FALSE in an</span></i>
<i><span style="color: navy;">//* OnEndSessionQuery will stop the process of shutting down</span></i>
<i><span style="color: navy;">//* Windows. You would only need this if you need to keep the user</span></i>
<i><span style="color: navy;">//* from ending his Windows session while your program is running.</span></i>
<i><span style="color: navy;">//*</span></i>
<i><span style="color: navy;">//* I'd be honored to hear what you think of this component.</span></i>
<i><span style="color: navy;">//* You can write me at shevine@aol.com.</span></i>
<i><span style="color: navy;">//*************************************************************</span></i>
<i><span style="color: navy;">//*************************************************************</span></i>
<b>interface</b>
<b>uses</b>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
<i><span style="color: navy;">{$IFNDEF Delphi3orHigher}</span></i>
OLE2,
<i><span style="color: navy;">{$ELSE}</span></i>
ActiveX, ComObj,
<i><span style="color: navy;">{$ENDIF}</span></i>
ShlObj;
<b>const</b>
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;
<b>type</b> NOTIFYREGISTER = <b>record</b>
pidlPath : PItemIDList;
bWatchSubtree : boolean;
<b>end</b>;
<b>type</b> PNOTIFYREGISTER = ^NOTIFYREGISTER;
<b>type</b> TTextCase = (tcAsIs,tcUppercase,tcLowercase);
<b>type</b>
TOneParmEvent = <b>procedure</b>(Sender : TObject; Flags : cardinal; Path1 : <b>string</b>) <b>of</b> <b>object</b>;
TTwoParmEvent = <b>procedure</b>(Sender : TObject; Flags : cardinal; Path1, Path2 : <b>string</b>) <b>of</b> <b>object</b>;
TEndSessionQueryEvent = <b>procedure</b>(Sender: TObject; <b>var</b> CanEndSession: Boolean) <b>of</b> <b>object</b>;
<b>function</b> SHChangeNotifyRegister(
hWnd : HWND;
dwFlags : integer;
wEventMask : cardinal;
uMsg : UINT;
cItems : integer;
lpItems : PNOTIFYREGISTER) : HWND; stdcall;
<b>function</b> SHChangeNotifyDeregister(
hWnd : HWND) : boolean; stdcall;
<b>function</b> SHILCreateFromPath(Path: Pointer;
PIDL: PItemIDList; <b>var</b> Attributes: ULONG):
HResult; stdcall;
<b>type</b>
TSHChangeNotify = <b>class</b>(TComponent)
<b>private</b>
fTextCase : TTextCase;
fHardDriveOnly : boolean;
NotifyCount : integer;
NotifyHandle : hwnd;
NotifyArray : <b>array</b>[1..26] <b>of</b> NOTIFYREGISTER;
AllocInterface : IMalloc;
PrevMsg : integer;
prevpath1 : <b>string</b>;
prevpath2 : <b>string</b>;
fMessageNo : integer;
fAssocChanged : TTwoParmEvent;
fAttributes : TOneParmEvent;
fCreate : TOneParmEvent;
fDelete : TOneParmEvent;
fDriveAdd : TOneParmEvent;
fDriveAddGUI : TOneParmEvent;
fDriveRemoved : TOneParmEvent;
fMediaInserted : TOneParmEvent;
fMediaRemoved : TOneParmEvent;
fMkDir : TOneParmEvent;
fNetShare : TOneParmEvent;
fNetUnshare : TOneParmEvent;
fRenameFolder : TTwoParmEvent;
fRenameItem : TTwoParmEvent;
fRmDir : TOneParmEvent;
fServerDisconnect : TOneParmEvent;
fUpdateDir : TOneParmEvent;
fUpdateImage : TOneParmEvent;
fUpdateItem : TOneParmEvent;
fEndSessionQuery : TEndSessionQueryEvent;
OwnerWindowProc : TWndMethod;
<b>procedure</b> SetMessageNo(value : integer);
<b>procedure</b> WndProc(<b>var</b> msg: TMessage);
<b>protected</b>
<b>procedure</b> QueryEndSession(<b>var</b> msg: TMessage);
<b>public</b>
<b>constructor</b> Create(AOwner : TComponent); <b>override</b>;
<b>destructor</b> Destroy; <b>override</b>;
<b>procedure</b> Execute;
<b>procedure</b> Stop;
<b>published</b>
<b>property</b> MessageNo : integer <b>read</b> fMessageNo <b>write</b> SetMessageNo <b>default</b> WM_USER;
<b>property</b> TextCase : TTextCase <b>read</b> fTextCase <b>write</b> fTextCase <b>default</b> tcAsIs;
<b>property</b> HardDriveOnly : boolean <b>read</b> fHardDriveOnly <b>write</b> fHardDriveOnly <b>default</b> True;
<b>property</b> OnAssocChanged : TTwoParmEvent <b>read</b> fAssocChanged <b>write</b> fAssocChanged;
<b>property</b> OnAttributes : TOneParmEvent <b>read</b> fAttributes <b>write</b> fAttributes;
<b>property</b> OnCreate : TOneParmEvent <b>read</b> fCreate <b>write</b> fCreate;
<b>property</b> OnDelete : TOneParmEvent <b>read</b> fDelete <b>write</b> fDelete;
<b>property</b> OnDriveAdd : TOneParmEvent <b>read</b> fDriveAdd <b>write</b> fDriveAdd;
<b>property</b> OnDriveAddGUI : TOneParmEvent <b>read</b> fDriveAddGUI <b>write</b> fDriveAddGUI;
<b>property</b> OnDriveRemoved : TOneParmEvent <b>read</b> fDriveRemoved <b>write</b> fDriveRemoved;
<b>property</b> OnMediaInserted : TOneParmEvent <b>read</b> fMediaInserted <b>write</b> fMediaInserted;
<b>property</b> OnMediaRemoved : TOneParmEvent <b>read</b> fMediaRemoved <b>write</b> fMediaRemoved;
<b>property</b> OnMkDir : TOneParmEvent <b>read</b> fMkDir <b>write</b> fMkDir;
<b>property</b> OnNetShare : TOneParmEvent <b>read</b> fNetShare <b>write</b> fNetShare;
<b>property</b> OnNetUnshare : TOneParmEvent <b>read</b> fNetUnshare <b>write</b> fNetUnshare;
<b>property</b> OnRenameFolder : TTwoParmEvent <b>read</b> fRenameFolder <b>write</b> fRenameFolder;
<b>property</b> OnRenameItem : TTwoParmEvent <b>read</b> fRenameItem <b>write</b> fRenameItem;
<b>property</b> OnRmDir : TOneParmEvent <b>read</b> fRmDir <b>write</b> fRmDir;
<b>property</b> OnServerDisconnect : TOneParmEvent <b>read</b> fServerDisconnect <b>write</b> fServerDisconnect;
<b>property</b> OnUpdateDir : TOneParmEvent <b>read</b> fUpdateDir <b>write</b> fUpdateDir;
<b>property</b> OnUpdateImage : TOneParmEvent <b>read</b> fUpdateImage <b>write</b> fUpdateImage;
<b>property</b> OnUpdateItem : TOneParmEvent <b>read</b> fUpdateItem <b>write</b> fUpdateItem;
<b>property</b> OnEndSessionQuery : TEndSessionQueryEvent
read fEndSessionQuery write fEndSessionQuery;
<i><span style="color: navy;">{ Published declarations }</span></i>
<b>end</b>;
<b>procedure</b> Register;
<b>implementation</b>
<b>const</b> Shell32DLL = <span style="color: blue;">'shell32.dll'</span>;
<b>function</b> SHChangeNotifyRegister;
external Shell32DLL index 2;
<b>function</b> SHChangeNotifyDeregister;
external Shell32DLL index 4;
<b>function</b> SHILCreateFromPath;
external Shell32DLL index 28;
<b>procedure</b> Register;
<b>begin</b>
RegisterComponents(<span style="color: blue;">'Custom'</span>, [TSHChangeNotify]);
<b>end</b>;
<i><span style="color: navy;">// Set defaults, and ensure NotifyHandle is zero.</span></i>
<b>constructor</b> TSHChangeNotify.Create (AOwner : TComponent);
<b>begin</b>
<b>inherited</b> Create(AOwner);
fTextCase := tcAsIs;
fHardDriveOnly := true;
fAssocChanged := <b>nil</b>;
fAttributes := <b>nil</b>;
fCreate := <b>nil</b>;
fDelete := <b>nil</b>;
fDriveAdd := <b>nil</b>;
fDriveAddGUI := <b>nil</b>;
fDriveRemoved := <b>nil</b>;
fMediaInserted := <b>nil</b>;
fMediaRemoved := <b>nil</b>;
fMkDir := <b>nil</b>;
fNetShare := <b>nil</b>;
fNetUnshare := <b>nil</b>;
fRenameFolder := <b>nil</b>;
fRenameItem := <b>nil</b>;
fRmDir := <b>nil</b>;
fServerDisconnect := <b>nil</b>;
fUpdateDir := <b>nil</b>;
fUpdateImage := <b>nil</b>;
fUpdateItem := <b>nil</b>;
fEndSessionQuery := <b>nil</b>;
MessageNo := WM_USER;
<i><span style="color: navy;">// If designing, dodge the code that implements messag interception.</span></i>
<b>if</b> csDesigning <b>in</b> ComponentState
<b>then</b> exit;
<i><span style="color: navy;">// Substitute our window proc for our owner's window proc.</span></i>
OwnerWindowProc := (Owner <b>as</b> TWinControl).WindowProc;
(Owner <b>as</b> TWinControl).WindowProc := WndProc;
<i><span style="color: navy;">// Get the IMAlloc interface so we can free PIDLs.</span></i>
SHGetMalloc(AllocInterface);
<b>end</b>;
<b>procedure</b> TSHChangeNotify.SetMessageNo(value : integer);
<b>begin</b>
<b>if</b> (value >= WM_USER)
<b>then</b> fMessageNo := value
<b>else</b> <b>raise</b> Exception.Create
(<span style="color: blue;">'MessageNo must be greater than or equal to '</span>
+ inttostr(WM_USER));
<b>end</b>;
<i><span style="color: navy;">// Execute unregisters any current notification and registers a new one.</span></i>
<b>procedure</b> TSHChangeNotify.Execute;
<b>var</b>
EventMask : integer;
driveletter : <b>string</b>;
i : integer;
pidl : PItemIDList;
Attributes : ULONG;
NotifyPtr : PNOTIFYREGISTER;
<b>begin</b>
NotifyCount := 0;
<b>if</b> csDesigning <b>in</b> ComponentState
<b>then</b> exit;
Stop; <i><span style="color: navy;">// Unregister the current notification, if any.</span></i>
EventMask := 0;
<b>if</b> assigned(fAssocChanged ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_ASSOCCHANGED);
<b>if</b> assigned(fAttributes ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_ATTRIBUTES);
<b>if</b> assigned(fCreate ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_CREATE);
<b>if</b> assigned(fDelete ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_DELETE);
<b>if</b> assigned(fDriveAdd ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_DRIVEADD);
<b>if</b> assigned(fDriveAddGUI ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_DRIVEADDGUI);
<b>if</b> assigned(fDriveRemoved ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_DRIVEREMOVED);
<b>if</b> assigned(fMediaInserted ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_MEDIAINSERTED);
<b>if</b> assigned(fMediaRemoved ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_MEDIAREMOVED);
<b>if</b> assigned(fMkDir ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_MKDIR);
<b>if</b> assigned(fNetShare ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_NETSHARE);
<b>if</b> assigned(fNetUnshare ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_NETUNSHARE);
<b>if</b> assigned(fRenameFolder ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_RENAMEFOLDER);
<b>if</b> assigned(fRenameItem ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_RENAMEITEM);
<b>if</b> assigned(fRmDir ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_RMDIR);
<b>if</b> assigned(fServerDisconnect ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_SERVERDISCONNECT);
<b>if</b> assigned(fUpdateDir ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_UPDATEDIR);
<b>if</b> assigned(fUpdateImage ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_UPDATEIMAGE);
<b>if</b> assigned(fUpdateItem ) <b>then</b> EventMask := (EventMask <b>or</b> SHCNE_UPDATEITEM);
<b>if</b> EventMask = 0 <i><span style="color: navy;">// If there's no event mask</span></i>
<b>then</b> exit; <i><span style="color: navy;">// then there's no need to set an event.</span></i>
<i><span style="color: navy;">// If the user requests watches on hard drives only, cycle through</span></i>
<i><span style="color: navy;">// the list of drive letters and add a NotifyList element for each.</span></i>
<i><span style="color: navy;">// Otherwise, just set the first element to watch the entire file</span></i>
<i><span style="color: navy;">// system.</span></i>
<b>if</b> fHardDriveOnly
<b>then</b> <b>for</b> i := ord(<span style="color: blue;">'A'</span>) <b>to</b> ord(<span style="color: blue;">'Z'</span>) <b>do</b> <b>begin</b>
DriveLetter := char(i) + <span style="color: blue;">':\'</span>;
<b>if</b> GetDriveType(pchar(DriveLetter)) = DRIVE_FIXED
<b>then</b> <b>begin</b>
inc(NotifyCount);
<b>with</b> NotifyArray[NotifyCount] <b>do</b> <b>begin</b>
SHILCreateFromPath
(pchar(DriveLetter),
addr(pidl),
Attributes);
pidlPath := pidl;
bWatchSubtree := true;
<b>end</b>;
<b>end</b>;
<b>end</b>
<i><span style="color: navy;">// If the caller requests the entire file system be watched,</span></i>
<i><span style="color: navy;">// prepare the first NotifyElement accordingly.</span></i>
<b>else</b> <b>begin</b>
NotifyCount := 1;
<b>with</b> NotifyArray[1] <b>do</b> <b>begin</b>
pidlPath := <b>nil</b>;
bWatchSubtree := true;
<b>end</b>;
<b>end</b>;
NotifyPtr := addr(NotifyArray);
NotifyHandle := SHChangeNotifyRegister(
(Owner <b>as</b> TWinControl).Handle,
SHCNF_ACCEPT_INTERRUPTS +
SHCNF_ACCEPT_NON_INTERRUPTS,
EventMask,
fMessageNo,
NotifyCount,
NotifyPtr);
<b>if</b> NotifyHandle = 0
<b>then</b> <b>begin</b>
Stop;
<b>raise</b> Exception.Create(<span style="color: blue;">'Could not register SHChangeNotify'</span>);
<b>end</b>;
<b>end</b>;
<i><span style="color: navy;">// This procedure unregisters the Change Notification</span></i>
<b>procedure</b> TSHChangeNotify.Stop;
<b>var</b>
NotifyHandle : hwnd;
i : integer;
pidl : PITEMIDLIST;
<b>begin</b>
<b>if</b> csDesigning <b>in</b> ComponentState
<b>then</b> exit;
<i><span style="color: navy;">// Deregister the shell notification.</span></i>
<b>if</b> NotifyCount > 0
<b>then</b> SHChangeNotifyDeregister(NotifyHandle);
<i><span style="color: navy;">// Free the PIDLs in NotifyArray.</span></i>
<b>for</b> i := 1 <b>to</b> NotifyCount <b>do</b> <b>begin</b>
pidl := NotifyArray[i].PidlPath;
<b>if</b> AllocInterface.DidAlloc(pidl) = 1
<b>then</b> AllocInterface.Free(pidl);
<b>end</b>;
NotifyCount := 0;
<b>end</b>;
<i><span style="color: navy;">// This is the procedure that is called when a change notification occurs.</span></i>
<i><span style="color: navy;">// It interprets the two PIDLs passed to it, and calls the appropriate</span></i>
<i><span style="color: navy;">// event handler, according to what kind of event occurred.</span></i>
<b>procedure</b> TSHChangeNotify.WndProc(<b>var</b> msg: TMessage);
<b>type</b>
TPIDLLIST = <b>record</b>
pidlist : <b>array</b>[1..2] <b>of</b> PITEMIDLIST;
<b>end</b>;
PIDARRAY = ^TPIDLLIST;
<b>var</b>
Path1 : <b>string</b>;
Path2 : <b>string</b>;
ptr : PIDARRAY;
p1,p2 : PITEMIDLIST;
repeated : boolean;
p : integer;
event : longint;
parmcount : byte;
OneParmEvent : TOneParmEvent;
TwoParmEvent : TTwoParmEvent;
<i><span style="color: navy;">// The internal function ParsePidl returns the string corresponding</span></i>
<i><span style="color: navy;">// to a PIDL.</span></i>
<b>function</b> ParsePidl (Pidl : PITEMIDLIST) : <b>string</b>;
<b>begin</b>
SetLength(result,MAX_PATH);
<b>if</b> <b>not</b> SHGetPathFromIDList(Pidl,pchar(result))
<b>then</b> result := <span style="color: blue;">''</span>;
<b>end</b>;
<i><span style="color: navy;">// The actual message handler starts here.</span></i>
<b>begin</b>
<b>if</b> Msg.Msg = WM_QUERYENDSESSION
<b>then</b> QueryEndSession(Msg);
<b>if</b> Msg.Msg = fMessageNo
<b>then</b> <b>begin</b>
OneParmEvent := <b>nil</b>;
TwoParmEvent := <b>nil</b>;
event := msg.LParam <b>and</b> ($7FFFFFFF);
<b>case</b> event <b>of</b>
SHCNE_ASSOCCHANGED : TwoParmEvent := fAssocChanged;
SHCNE_ATTRIBUTES : OneParmEvent := fAttributes;
SHCNE_CREATE : OneParmEvent := fCreate;
SHCNE_DELETE : OneParmEvent := fDelete;
SHCNE_DRIVEADD : OneParmEvent := fDriveAdd;
SHCNE_DRIVEADDGUI : OneParmEvent := fDriveAddGUI;
SHCNE_DRIVEREMOVED : OneParmEvent := fDriveRemoved;
SHCNE_MEDIAINSERTED : OneParmEvent := fMediaInserted;
SHCNE_MEDIAREMOVED : OneParmEvent := fMediaRemoved;
SHCNE_MKDIR : OneParmEvent := fMkDir;
SHCNE_NETSHARE : OneParmEvent := fNetShare;
SHCNE_NETUNSHARE : OneParmEvent := fNetUnshare;
SHCNE_RENAMEFOLDER : TwoParmEvent := fRenameFolder;
SHCNE_RENAMEITEM : TwoParmEvent := fRenameItem;
SHCNE_RMDIR : OneParmEvent := fRmDir;
SHCNE_SERVERDISCONNECT : OneParmEvent := fServerDisconnect;
SHCNE_UPDATEDIR : OneParmEvent := fUpdateDir;
SHCNE_UPDATEIMAGE : OneParmEvent := fUpdateImage;
SHCNE_UPDATEITEM : OneParmEvent := fUpdateItem;
<b>else</b> <b>begin</b>
OneParmEvent := <b>nil</b>; <i><span style="color: navy;">// Unknown event;</span></i>
TwoParmEvent := <b>nil</b>;
<b>end</b>;
<b>end</b>;
<b>if</b> (assigned(OneParmEvent)) <b>or</b> (assigned(TwoParmEvent))
<b>then</b> <b>begin</b>
<i><span style="color: navy;">// Assign a pointer to the array of PIDLs sent</span></i>
<i><span style="color: navy;">// with the message.</span></i>
ptr := PIDARRAY(msg.wParam);
<i><span style="color: navy;">// Parse the two PIDLs.</span></i>
p1 := ptr^.pidlist[1];
<b>try</b>
SetLength(Path1,MAX_PATH);
Path1 := ParsePidl(p1);
p := pos(#00,Path1);
<b>if</b> p > 0
<b>then</b> SetLength(Path1,p - 1);
<b>except</b>
Path1 := <span style="color: blue;">''</span>;
<b>end</b>;
p2 := ptr^.pidlist[2];
<b>try</b>
SetLength(Path2,MAX_PATH);
Path2 := ParsePidl(p2);
p := pos(#00,Path2);
<b>if</b> p > 0
<b>then</b> SetLength(Path2,p - 1);
<b>except</b>
Path2 := <span style="color: blue;">''</span>;
<b>end</b>;
<i><span style="color: navy;">// If this message is the same as the last one (which happens</span></i>
<i><span style="color: navy;">// a lot), bail out.</span></i>
<b>try</b>
repeated := (PrevMsg = event)
<b>and</b> (uppercase(prevpath1) = uppercase(Path1))
<b>and</b> (uppercase(prevpath2) = uppercase(Path2))
<b>except</b>
repeated := false;
<b>end</b>;
<i><span style="color: navy;">// Save the elements of this message for comparison next time.</span></i>
PrevMsg := event;
PrevPath1 := Path1;
PrevPath2 := Path2;
<i><span style="color: navy;">// Convert the case of Path1 and Path2 if desired.</span></i>
<b>case</b> fTextCase <b>of</b>
tcUppercase : <b>begin</b>
Path1 := uppercase(Path1);
Path2 := uppercase(Path2);
<b>end</b>;
tcLowercase : <b>begin</b>
Path1 := lowercase(Path1);
Path2 := lowercase(Path2);
<b>end</b>;
<b>end</b>;
<i><span style="color: navy;">// Call the event handler according to the number</span></i>
<i><span style="color: navy;">// of paths we will pass to it.</span></i>
<b>if</b> <b>not</b> repeated <b>then</b> <b>begin</b>
<b>case</b> event <b>of</b>
SHCNE_ASSOCCHANGED,
SHCNE_RENAMEFOLDER,
SHCNE_RENAMEITEM : parmcount := 2;
<b>else</b> parmcount := 1;
<b>end</b>;
<b>if</b> parmcount = 1
<b>then</b> OneParmEvent(self, event, Path1)
<b>else</b> TwoParmEvent(self, event, Path1, Path2);
<b>end</b>;
<b>end</b>; <i><span style="color: navy;">// if assigned(OneParmEvent)...</span></i>
<b>end</b>; <i><span style="color: navy;">// if Msg.Msg = fMessageNo...</span></i>
<i><span style="color: navy;">// Call the original message handler.</span></i>
OwnerWindowProc(Msg);
<b>end</b>;
<b>procedure</b> TSHChangeNotify.QueryEndSession(<b>var</b> msg: TMessage);
<b>var</b>
CanEndSession : boolean;
<b>begin</b>
CanEndSession := true;
<b>if</b> Assigned(fEndSessionQuery)
<b>then</b> fEndSessionQuery(Self, CanEndSession);
<b>if</b> CanEndSession
<b>then</b> <b>begin</b>
Stop;
Msg.Result := 1;
<b>end</b>
<b>else</b> Msg.Result := 0;
<b>end</b>;
<b>destructor</b> TSHChangeNotify.Destroy;
<b>begin</b>
<b>if</b> <b>not</b> (csDesigning <b>in</b> ComponentState)
<b>then</b> <b>begin</b>
<b>if</b> Assigned(Owner)
<b>then</b> (Owner <b>as</b> TWinControl).WindowProc := OwnerWindowProc;
Stop;
<b>end</b>;
<b>inherited</b>;
<b>end</b>;
<b>end</b>.
<span style="color: navy;"><i>{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi@aboutguide.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}</i></span></span></pre>
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-54049325647000615712012-11-22T10:26:00.002-08:002012-11-22T10:26:46.363-08:00Get Current User's SID<pre>...Retrieve the current user's SID?
Author: Yorai Aminov
Homepage: http://www.shorterpath.com
Category: System
(******************************************************************************)
(* SPGetSid - Retrieve the current user's SID in text format *)
(* *)
(* Copyright (c) 2004 Shorter Path Software *)
(* http://www.shorterpath.com *)
(******************************************************************************)
{
SID is a data structure of variable length that identifies user, group,
and computer accounts.
Every account on a network is issued a unique SID when the account is first created.
Internal processes in Windows refer to an account's SID
rather than the account's user or group name.
}
unit SPGetSid;
interface
uses
Windows, SysUtils;
function GetCurrentUserSid: string;
implementation
const
HEAP_ZERO_MEMORY = $00000008;
SID_REVISION = 1; // Current revision level
type
PTokenUser = ^TTokenUser;
TTokenUser = packed record
User: TSidAndAttributes;
end;
function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL;
var
psia: PSIDIdentifierAuthority;
dwSubAuthorities: DWORD;
dwSidRev: DWORD;
dwCounter: DWORD;
dwSidSize: DWORD;
begin
Result := False;
dwSidRev := SID_REVISION;
if not IsValidSid(Sid) then Exit;
psia := GetSidIdentifierAuthority(Sid);
dwSubAuthorities := GetSidSubAuthorityCount(Sid)^;
dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char);
if (dwBufferLen < dwSidSize) then
begin
dwBufferLen := dwSidSize;
SetLastError(ERROR_INSUFFICIENT_BUFFER);
Exit;
end;
StrFmt(pszSidText, 'S-%u-', [dwSidRev]);
if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then
StrFmt(pszSidText + StrLen(pszSidText),
'0x%.2x%.2x%.2x%.2x%.2x%.2x',
[psia.Value[0], psia.Value[1], psia.Value[2],
psia.Value[3], psia.Value[4], psia.Value[5]])
else
StrFmt(pszSidText + StrLen(pszSidText),
'%u',
[DWORD(psia.Value[5]) +
DWORD(psia.Value[4] shl 8) +
DWORD(psia.Value[3] shl 16) +
DWORD(psia.Value[2] shl 24)]);
dwSidSize := StrLen(pszSidText);
for dwCounter := 0 to dwSubAuthorities - 1 do
begin
StrFmt(pszSidText + dwSidSize, '-%u',
[GetSidSubAuthority(Sid, dwCounter)^]);
dwSidSize := StrLen(pszSidText);
end;
Result := True;
end;
function ObtainTextSid(hToken: THandle; pszSid: PChar;
var dwBufferLen: DWORD): BOOL;
var
dwReturnLength: DWORD;
dwTokenUserLength: DWORD;
tic: TTokenInformationClass;
ptu: Pointer;
begin
Result := False;
dwReturnLength := 0;
dwTokenUserLength := 0;
tic := TokenUser;
ptu := nil;
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength);
if ptu = nil then Exit;
dwTokenUserLength := dwReturnLength;
dwReturnLength := 0;
if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength,
dwReturnLength) then Exit;
end
else
Exit;
end;
if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit;
if not HeapFree(GetProcessHeap, 0, ptu) then Exit;
Result := True;
end;
function GetCurrentUserSid: string;
var
hAccessToken: THandle;
bSuccess: BOOL;
dwBufferLen: DWORD;
szSid: array[0..260] of Char;
begin
Result := '';
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
ZeroMemory(@szSid, SizeOf(szSid));
dwBufferLen := SizeOf(szSid);
if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then
Result := szSid;
CloseHandle(hAccessToken);
end;
end;
end.
</pre>Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-14373609905553635172012-11-09T15:00:00.000-08:002012-11-13T01:52:30.310-08:00Use a TPanel as a host for child windows (MDI simulation)
<br/>
Problem/Question/Abstract:<br/>
<br/>
I was wondering if someone can offer assistance with this application. Basically the application is for configuring our system. At present it is a MDI where child windows are various functions (security, report options, etc.). The number of functions are growing, currently around 15, which means an increase in different child forms and, overall, a growing exe. I would like the child forms to be standalone programs or dlls which can appear in the control program as child windows and also execute by themselves. Only one child form is displayed at a time and always maximised within the parent window. I did see some code about that provided for a dll as a child form, but this would not help as a standalone execution.<br/>
<br/>
Answer:<br/>
<br/>
This is an interesting problem. As it happens it is possible in Win32 to make another processes window appear like a child window in ones own windows. It does not work quite as well as a true child in your own process but takes care about moving the pseudo-child with your menu app.<br/>
<br/>
The general design is this: the main/menu app has a form with menu, perhaps tool and status bars, and a client-aligned panel that will serve as the host for the child windows. It reads the available child apps from INI file or registry key and builds a menu or selection list from this info. On user request it launches the appropriate child app and passes the panels window handle on the commandline. The child app checks the command line, if there are no parameters it rans as designed, if there is a parameter it reads it, removes its border and bordericon, parents itself to the passed window handle and sizes itself to its client area. It also sends a message with *its* window handle to the panels parent (the main app form) to register itself. The main app can close the child with this handle and also resize it when the user resizes the main app.<br/>
<br/>
Main app: has a menu with two entries (OpenMenu, CloseMenu), a toolbar with two buttons attached to the same events as the two menus, a statusbar, a client-aliged panel.<br/>
<br/>
unit MenuApp;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br/>
Menus, ExtCtrls, ComCtrls, ToolWin;<br/>
<br/>
const<br/>
UM_CHILDREGISTER = WM_USER + 111;<br/>
UM_CHILDUNREGISTER = WM_USER + 112;<br/>
<br/>
type<br/>
TUmChildRegister = packed record<br/>
msg: Cardinal;<br/>
childwnd: HWND;<br/>
unused: Integer;<br/>
result: Integer;<br/>
end;<br/>
TUmChildUnregister = TUmChildregister;<br/>
<br/>
TForm1 = class(TForm)<br/>
MainMenu1: TMainMenu;<br/>
OpenMenu: TMenuItem;<br/>
StatusBar1: TStatusBar;<br/>
ToolBar1: TToolBar;<br/>
ToolButton1: TToolButton;<br/>
CloseMenu: TMenuItem;<br/>
ToolButton2: TToolButton;<br/>
Panel1: TPanel;<br/>
procedure OpenMenuClick(Sender: TObject);<br/>
procedure CloseMenuClick(Sender: TObject);<br/>
procedure Panel1Resize(Sender: TObject);<br/>
procedure FormClose(Sender: TObject; var Action: TCloseAction);<br/>
private<br/>
{ Private declarations }<br/>
FChildAppHandle: HWND;<br/>
procedure UMChildRegister(var msg: TUmChildRegister);<br/>
message UM_CHILDREGISTER;<br/>
procedure UMChildUnRegister(var msg: TUmChildUnRegister);<br/>
message UM_CHILDUNREGISTER;<br/>
public<br/>
{ Public declarations }<br/>
end;<br/>
<br/>
var<br/>
Form1: TForm1;<br/>
<br/>
implementation<br/>
<br/>
uses<br/>
shellapi;<br/>
<br/>
{$R *.DFM}<br/>
<br/>
procedure TForm1.OpenMenuClick(Sender: TObject);<br/>
var<br/>
path, param: string;<br/>
begin<br/>
if FChildAppHandle = 0 then<br/>
begin<br/>
path := ExtractFilePath(Application.Exename) + 'childAppProj.exe';<br/>
param := '$' + IntTohex(panel1.handle, 8);<br/>
ShellExecute(handle, 'open', pchar(path), pchar(param), nil, SW_SHOWNORMAL);<br/>
end<br/>
else<br/>
ShowMessage('Child already loaded');<br/>
end;<br/>
<br/>
procedure TForm1.CloseMenuClick(Sender: TObject);<br/>
begin<br/>
if FChildAppHandle <> 0 then<br/>
SendMessage(FchildApphandle, WM_CLOSE, 0, 0);<br/>
end;<br/>
<br/>
procedure TForm1.Panel1Resize(Sender: TObject);<br/>
begin<br/>
if FChildAppHandle <> 0 then<br/>
MoveWindow(FchildAppHandle, 0, 0, Panel1.ClientWidth, Panel1.ClientHeight, true);<br/>
end;<br/>
<br/>
procedure TForm1.UMChildRegister(var msg: TUmChildRegister);<br/>
begin<br/>
FChildAppHandle := msg.childwnd;<br/>
end;<br/>
<br/>
procedure TForm1.UMChildUnRegister(var msg: TUmChildUnRegister);<br/>
begin<br/>
if FChildAppHandle = msg.childwnd then<br/>
FChildAppHandle := 0;<br/>
end;<br/>
<br/>
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);<br/>
begin<br/>
if FChildAppHandle <> 0 then<br/>
SendMessage(FchildApphandle, WM_CLOSE, 0, 0);<br/>
end;<br/>
<br/>
end.<br/>
<br/>
Child app has a couple of edits, two buttons, a memo.<br/>
<br/>
unit ChildApp;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br/>
StdCtrls, AppEvnts;<br/>
<br/>
type<br/>
TForm2 = class(TForm)<br/>
Edit1: TEdit;<br/>
Edit2: TEdit;<br/>
Edit3: TEdit;<br/>
Button1: TButton;<br/>
Memo1: TMemo;<br/>
Button2: TButton;<br/>
ApplicationEvents1: TApplicationEvents;<br/>
procedure Button1Click(Sender: TObject);<br/>
procedure ApplicationEvents1Activate(Sender: TObject);<br/>
procedure FormClose(Sender: TObject; var Action: TCloseAction);<br/>
procedure FormResize(Sender: TObject);<br/>
private<br/>
{ Private declarations }<br/>
FMenuAppWnd: HWND;<br/>
FParentPanelWnd: HWND;<br/>
public<br/>
{ Public declarations }<br/>
constructor Create(aOwner: TComponent); override;<br/>
procedure CreateWnd; override;<br/>
procedure DestroyWnd; override;<br/>
end;<br/>
<br/>
var<br/>
Form2: TForm2;<br/>
<br/>
implementation<br/>
<br/>
{$R *.DFM}<br/>
<br/>
const<br/>
UM_CHILDREGISTER = WM_USER + 111;<br/>
UM_CHILDUNREGISTER = WM_USER + 112;<br/>
<br/>
procedure TForm2.Button1Click(Sender: TObject);<br/>
begin<br/>
close;<br/>
end;<br/>
<br/>
procedure TForm2.ApplicationEvents1Activate(Sender: TObject);<br/>
begin<br/>
if FMenuAppWnd <> 0 then<br/>
SendMessage(FMenuAppWnd, WM_NCACTIVATE, 1, 0);<br/>
memo1.lines.add('Activated');<br/>
end;<br/>
<br/>
constructor TForm2.Create(aOwner: TComponent);<br/>
begin<br/>
if ParamCount > 0 then<br/>
begin<br/>
FParentPanelWnd := StrToInt(ParamStr(1));<br/>
FMenuAppWnd := Windows.GetParent(FParentPanelWnd);<br/>
end;<br/>
inherited;<br/>
if FParentPanelWnd <> 0 then<br/>
begin<br/>
Borderstyle := bsNone;<br/>
BorderIcons := [];<br/>
{remove taskbar button for the child app}<br/>
SetWindowLong(Application.Handle, GWL_EXSTYLE,<br/>
GetWindowLong(Application.Handle, GWL_EXSTYLE)<br/>
and not WS_EX_APPWINDOW or WS_EX_TOOLWINDOW);<br/>
end;<br/>
end;<br/>
<br/>
procedure TForm2.CreateWnd;<br/>
var<br/>
r: Trect;<br/>
begin<br/>
inherited;<br/>
if FMenuAppWnd <> 0 then<br/>
begin<br/>
SendMessage(FMenuAppWnd, UM_CHILDREGISTER, handle, 0);<br/>
Windows.SetPArent(handle, FParentPanelWnd);<br/>
Windows.GetClientRect(FParentPanelWnd, r);<br/>
SetBounds(r.left, r.top, r.right - r.left, r.bottom - r.top);<br/>
end;<br/>
end;<br/>
<br/>
procedure TForm2.DestroyWnd;<br/>
begin<br/>
if FMenuAppWnd <> 0 then<br/>
SendMessage(FMenuAppWnd, UM_CHILDUNREGISTER, handle, 0);<br/>
inherited;<br/>
end;<br/>
<br/>
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);<br/>
begin<br/>
{Closing the main form does not fire DestroyWnd for some reason}<br/>
if FMenuAppWnd <> 0 then<br/>
SendMessage(FMenuAppWnd, UM_CHILDUNREGISTER, handle, 0);<br/>
end;<br/>
<br/>
procedure TForm2.FormResize(Sender: TObject);<br/>
begin<br/>
memo1.width := clientwidth - memo1.Left - 10;<br/>
memo1.height := clientheight - memo1.Top - 10;<br/>
end;<br/>
<br/>
end.<br/>
<br/>
One problem I noted is that sometimes the main applications caption will loose the active look when switching between main and child despite the action taken in the childs Application.OnActivate handler.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-85112925585451878152012-06-21T15:00:00.000-07:002012-11-11T01:57:05.500-08:00Using Indy idHTTP to post binary and text <br />
Problem/Question/Abstract:<br />
<br />
Using Indy idHTTP to post binary and text<br />
<br />
Answer:<br />
<br />
This is a small example of using post to send data to web server. There is two different ways to do this operation.<br />
<br />
Solve 1:<br />
<br />
procedure TForm1.SendPostData;<br />
const<br />
CRLF = #13#10;<br />
var<br />
aStream: TMemoryStream;<br />
Params: TMemoryStream;<br />
S: string;<br />
begin<br />
aStream := TMemoryStream.create;<br />
Params := TMemoryStream.Create;<br />
<br />
HTTP.Request.ContentType := 'multipart/form-data;<br />
boundary = - - - - - - - - - - - - - - - - - - - - - - - - - - - - -7<br />
cf87224d2020a';<br />
<br />
try<br />
S := '-----------------------------7cf87224d2020a' + CRLF +<br />
'Content-Disposition: form-data; name="file1"; filename="c:abc.txt"' +<br />
CRLF +<br />
'Content-Type: text/plain' + CRLF + CRLF +<br />
'file one content. Contant-Type can be application/octet-stream or if<br />
you want you can ask your OS fot the exact type<br />
.' + CRLF +<br />
'-----------------------------7cf87224d2020a' + CRLF +<br />
'Content-Disposition: form-data; name="sys_return_url2"' + CRLF + CRLF +<br />
'hello2' + CRLF +<br />
'-----------------------------7cf87224d2020a--';<br />
<br />
Params.Write(S[1], Length(S));<br />
<br />
with HTTP do<br />
begin<br />
try<br />
HTTP.Post('http://www.mydomain.com/postexampe.cgi', Params,<br />
aStream);<br />
except<br />
on E: Exception do<br />
showmessage('Error encountered during POST: ' + E.Message);<br />
end;<br />
end;<br />
aStream.WriteBuffer(#0' ', 1);<br />
showmessage(PChar(aStream.Memory));<br />
except<br />
end;<br />
end;<br />
<br />
<br />
Solve 2:<br />
<br />
procedure TForm1.SendPostData;<br />
var<br />
aStream: TMemoryStream;<br />
Params: TStringStream;<br />
begin<br />
aStream := TMemoryStream.create;<br />
Params := TStringStream.create('');<br />
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';<br />
<br />
try<br />
Params.WriteString(URLEncode('sys_return_url=' + 'helo1' + '&'));<br />
Params.WriteString(URLEncode('sys_return_url=' + 'helo2'));<br />
with HTTP do<br />
begin<br />
try<br />
HTTP.Post('http://www.mydomain.com/postexampe.cgi', Params,<br />
aStream);<br />
except<br />
on E: Exception do<br />
showmessage('Error encountered during POST: ' + E.Message);<br />
end;<br />
end;<br />
aStream.WriteBuffer(#0' ', 1);<br />
showmessage(PChar(aStream.Memory));<br />
except<br />
end;<br />
end;<br />
<br />
As you can see there is a difference in the way post stream is constructed and the ContentType. In the first example ContentType is "multipart/form-data; boundary=-----------------------------7cf87224d2020a" and this boundary is used to separate different parameters.<br />
<br />
In the second example the ContentType is "application/x-www-form-urlencoded". In this case the paremeteras are passed in the form<br />
<br />
ParamName=ParamValue&ParamName=ParamValue<br />
<br />
Note that the Pramaeters in the second form must be URL encoded.<br />
<br />
Where these two formats of post information are used?<br />
<br />
The first one is used when you have binary data to post and the second one is when you are going to post only text fields. Unknownnoreply@blogger.com4tag:blogger.com,1999:blog-5232582584575965466.post-15312219326253112822011-06-24T06:06:00.000-07:002011-06-24T06:10:24.251-07:00Using SOAP with Delphi<br />
Problem/Question/Abstract:<br />
<br />
Using SOAP with Delphi<br />
<br />
Answer:<br />
<br />
Introduction<br />
<br />
The growth of the Internet has recently opened a completely new world of possibilities that were extremely difficult if not impossible to achieve ten years ago. The access to information has apparently become easier and the ability to get your data anytime and from anywhere in the world is considered pretty much a normal thing these days. With an Internet connection and a browser you are immediately able to check what's the latest and greatest home computer, compare it with others, buy it and monitor its delivery until it gets to your door.<br />
<br />
Unfortunately, as it often happens, when it comes to us developers it is not that easy to build what makes a user's life so easy. Data exchange, collaboration and cooperation are actually some of the most complex areas developers have to deal with. The devil is in the detail they say&#8230; Well, that area is definitely full of details. <br />
<br />
Component software is targeted to make data exchange, collaboration and cooperation easier. Technologies such as Corba and COM+ provide us with the backbone to make applications talk seamlessly to each other, regardless of the language used to build them or their location. This is possible because they define a standard way to describe the services and the clients that access them know what to ask for and how to ask for it.<br />
<br />
When it comes to the Internet, the solution that was perfect for your LAN based application doesn't work anymore. Scalability and standards become a real issue since you cannot predict the number of clients that will access your system and, worst of all, you don't know what is accessing your system. With so many standards around a standard client is the last thing you should expect.<br />
<br />
Not too long ago a new acronym begun to spread across the web: SOAP, the Simple Object Access Protocol. This new, XML based standard promises the ultimate solution to all our problems. It promises to deliver a universally supported standard and to do it in one of the most scalable ways. Many companies such as Borland, Microsoft and IBM are moving fast in order to make this happen. Borland's Delphi 6 and Kylix have SOAP support built in. Microsoft provides the SOAP SDK 1, is working on version 2 and the future .Net platform will offer even greater support for this technology. IBM on the other side is providing a Java-based implementation.<br />
<br />
SOAP?<br />
<br />
However, what is SOAP? Should you use it and if so, how can you use it today?<br />
<br />
SOAP enables you to encode complex data such as objects or procedure call parameters into an xml string (called a "SOAP Packet"). Because SOAP uses XML, it is not dependent on any particular language or operating system. SOAP packets can be stored in a database, posted in an email or a message queue or transmitted via HTTP. The most common use for SOAP is likely to be remote procedure calls implemented with SOAP transmitted over HTTP<br />
<br />
There's nothing really complex or unique about SOAP, except maybe its simplicity.<br />
<br />
As of today there's very little out there for a Delphi developer. Your best chance is to use what Microsoft provides at http://msdn.microsoft.com/xml with the SOAP SDKs version 1, and the beta of version 2 (currently Release Candidate 0 ). In my sample code you will find a Delphi component that wraps it and exposes some additional events.<br />
<br />
It's worth noticing also Dave Nottage's PureSOAP. This is a simple implementation that doesn't support complex objects but comes with full source code that may be of some interest. You can find it at http://www.puresoftwaretech.com/puresoap<br />
<br />
Luckily for us, As soon as Delphi 6 will be released, we will have much more to play with. <br />
<br />
A practical example<br />
<br />
In order to demonstrate a possible way to use SOAP today, I developed an example that is downloadable directly from here. The example includes the TSOAPClient component that wraps the equivalent SOAPClient COM component included in the Microsoft SOAP SDK version 2 (Release Candidate 0).<br />
<br />
Be aware that the WSDL file definition has changed from Beta 1 to RC0. I updated the msdelphi.com source files in order to work with the latest version (Release Candidate 0). These files will not work properly with Beta 1. The files in CodeCentral are still the old ones. <br />
<br />
The example demonstrates how to get a stock quote from a web server using SOAP.<br />
<br />
In a future article, I will demonstrate how a similar component can be developed using Delphi, with or without COM. It's worth noticing that SOAP does not require COM at all. The only reason for which I have chosen this approach is that creating a full-blown SOAP component would have been too much overhead for this introduction to SOAP.<br />
<br />
The instructions on how to install the example are contained in the file Readme.txt<br />
<br />
The example<br />
<br />
The SOAP server is a standard MTS object has only one method that given a ticker symbol returns its value. The method is defined as: <br />
<br />
function GetQuote(const Symbol: WideString): Double<br />
<br />
The client is a simple form that allows the user to enter a ticker symbol and displays the value that is returned by the server.<br />
<br />
<br />
<br />
This is the sequence of events that occurs after the user presses the &#8220;Get Quote" button:<br />
<br />
The TSOAPClient asks the web server for an XML file that describes the interface of the SOAP server. <br />
<br />
The web server returns a standard Web Services Description Language (WSDL) file. <br />
<br />
The client is now ready to invoke any method on the server and prepares the a GetQuote message which then sends to the server <br />
<br />
The web sever grabs the message and passes it to the SOAPServer COM object <br />
<br />
The SOAPServer object reads the SOAP message and invokes the GetQuote method of our test COM object <br />
<br />
After the execution of the COM call, the SOAPServer packages a response returning either the ticker quote or an error and sends it to the client <br />
<br />
The client finally displays the result<br />
<br />
Demystifying SOAP &#8211; Client side<br />
<br />
From the client perspective, SOAP method invocation is generally done using a proxy that simulates the interface of the SOAP server on the client side.<br />
<br />
When you press the &#8220;Get Quote" button in the client application the following code is executed:<br />
<br />
procedure TMainForm.bGetQuoteClick(Sender: TObject);<br />
var<br />
  quote: currency;<br />
begin<br />
  // Retrieves the WSDL information only the first time&#8230;<br />
  if SOAPClient.Connected or SOAPClient.Connect then<br />
  begin<br />
    // Invokes the GetQuote method<br />
    quote := SOAPClient.Client.GetQuote(eSticker.Text);<br />
    // Displays the result<br />
    ShowMessage(eSticker.Text + ' is worth ' + FloatToStr(quote) + '$');<br />
  end;<br />
end;<br />
<br />
What is happening here is that the client is asking the server to provide a description of the interface of the StockQuote service. In SOAP this is achieved by loading a Web Services Description Language (WSDL) XML file.<br />
<br />
In the example, this is accomplished by setting the WSDLURI property and calling the method Connect. The WSDL file that describes the StockQuote service looks like this:<br />
<br />
<?xml version='1.0' encoding='UTF-8' ?><br />
<definitions  name ='StockQuote'   targetNamespace = 'http://tempuri.org/wsdl/'<br />
xmlns:wsdlns='http://tempuri.org/wsdl/'<br />
xmlns:typens='http://tempuri.org/type'<br />
xmlns:soap='http://schemas.xmlsoap.org/wsdl/soap/'<br />
xmlns:xsd='http://www.w3.org/2001/XMLSchema'<br />
xmlns:stk='http://schemas.microsoft.com/soap-toolkit/wsdl-extension'<br />
xmlns='http://schemas.xmlsoap.org/wsdl/'><br />
  <types><br />
    <schema targetNamespace='http://tempuri.org/type'<br />
      xmlns='http://www.w3.org/2001/XMLSchema'<br />
      xmlns:SOAP-ENC='http://schemas.xmlsoap.org/soap/encoding/'<br />
      xmlns:wsdl='http://schemas.xmlsoap.org/wsdl/'<br />
      elementFormDefault='qualified'><br />
    </schema><br />
  </types><br />
  <message name='StockQuote.GetQuote'><br />
    <part name='Symbol' type='xsd:string'/><br />
  </message><br />
  <message name='StockQuote.GetQuoteResponse'><br />
    <part name='Result' type='xsd:double'/><br />
  </message><br />
[..]<br />
  <service name='StockQuote' ><br />
    <port name='StockQuoteSoapPort' binding='wsdlns:StockQuoteSoapBinding' ><br />
      <soap:address location='http://localhost/SOAP/StockQuote.ASP' /><br />
    </port><br />
  </service><br />
[..]<br />
<br />
As you can see, it says that the interface of the StockQuote SOAP service exposes one method called GetQuote. This method has string parameter called &#8220;Symbol" and returns a floating point.<br />
<br />
Towards the end of the file, you will find another important information: the <service> tag that contains information on the destination of the SOAP messages. The URL specified in this section will be used by the client as HTTP destination of the SOAP message.<br />
<br />
After the client has loaded and processed this file, it becomes aware of the interface of the service and knows what it can ask for and how to ask for it. The next step is to invoke the method GetQuote using the Client property of the SOAPClient.<br />
<br />
If you are not familiar with Variant method calls and late binding, I recommend reading Binh Ly's article at http://www.techvanguards.com/com/concepts/automation.htm<br />
<br />
After you call GetQuote, the proxy converts the method name and the parameters you invoked into a standard SOAP message and delivers it through HTTP to the destination. It is worth saying that you can implement the same behavior by building an object that implements IDispatch. You would just need to provide your own implementation of the methods GetIDsOfNames and Invoke. Another possible approach would be creating a regular Delphi class that would have a method such as: <br />
<br />
function SOAPInvoke(aMethodName: string; someParameters: array of OleVariant):<br />
  OleVariant;<br />
<br />
It is also possible to send a SOAP message using other protocols than HTTP. Although it is the most commonly used, nothing stops you from using regular sockets or even an e-mail.<br />
<br />
The server<br />
<br />
On the server side, a listener is constantly waiting to receive SOAP requests.In this example, since we are using HTTP, the web server is the listener and the target of the SOAP messages is the ASP file StockQuote.asp. Remember how this was specified in the WSDL file the client initially received.<br />
<br />
The SOAP Message that is received in this particular case is:<br />
<br />
<?xml version="1.0" encoding="UTF-8" standalone="no"?><br />
<SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"><br />
  <SOAP-ENV:Body><br />
    <m:GetQuote xmlns:m="http://tempuri.org/message/"><br />
      <Symbol>BORL</Symbol><br />
    </m:GetQuote><br />
  </SOAP-ENV:Body><br />
</SOAP-ENV:Envelope><br />
<br />
As you can see, the message not only indicates the name of the method that has to be invoked in the node, but also specifies the names of the parameters that the method needs.<br />
<br />
This instead, is part of the ASP file StockQuote.asp that illustrates what's happening on the server side:<br />
<br />
<%@ LANGUAGE=VBScript %><br />
<% Response.ContentType = "text/xml"%><br />
<%<br />
  [..]<br />
  Set SoapServer = Server.CreateObject("MSSOAP.SoapServer")<br />
  SoapServer.Init WSDLFilePath, WSMLFilePath<br />
  SoapServer.SoapInvoke Request, Response, ""<br />
  [..]<br />
%><br />
<br />
As you can see, the SOAPServer COM object is created and the SOAP message is delivered to it in the last line by passing the Request object to the SOAPServer.SoapInvoke method. In this case, since we are using the Microsoft SDK, we can only invoke methods of COM objects.<br />
<br />
Nothing would stop us from creating a similar component that would invoke methods of a Corba object or anything else you can imagine (an old COBOL application, a standard executable, a Java class, etc). The SOAP stub on the server will be specific to the platform you chose to adopt in-house. Microsoft obviously automated the translation of SOAP messages into COM calls. Other companies are currently doing the same for Corba and Java objects. This is the key behind the SOAP idea: you are completely free to use any technology you want to develop your in-house application . Whenever you need to expose some of these services to the outside world, you just put the appropriate SOAP translator on top of it.<br />
<br />
The following diagram illustrates this:<br />
<br />
<br />
<br />
Now, the last part of the puzzle is the response the server sends back to the client. Successful or failed responses must follow a standard too.<br />
<br />
This is how a successful result would look in our previous example:<br />
<br />
<?xml version="1.0" encoding="UTF-8" standalone="no"?><br />
<SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"><br />
  <SOAP-ENV:Body><br />
    <m:GetQuoteResponse xmlns:m="http://tempuri.org/message/"><br />
      <Result>100</Result><br />
    </m:GetQuoteResponse><br />
  </SOAP-ENV:Body><br />
</SOAP-ENV:Envelope><br />
<br />
In the event of any error instead (such an exception in the COM object) the standard format of a SOAP error message would look like this:<br />
<br />
<?xml version="1.0" encoding="UTF-8" standalone="no"?><br />
  <SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"><br />
    <SOAP-ENV:Body><br />
      <SOAP-ENV:Fault><br />
        <faultcode>SOAP-ENV:Server</faultcode><br />
<faultstring>WSDLOperation: Executing method GetQuote failed</faultstring><br />
<faultactor>http://tempuri.org/action/StockQuote.GetQuote</faultactor><br />
<detail><br />
[..]<br />
<mserror:description>A symbol must be specified</mserror:description><br />
[..]<br />
        </detail><br />
     </SOAP-ENV:Fault><br />
   </SOAP-ENV:Body><br />
</SOAP-ENV:Envelope><br />
<br />
The elements faultcode, faultstring and detail are accessible through the TSOAPClient. They are the standard way for SOAP to signal an error. The detail node has been extended in this case to provide additional error information. The subnodes msXXXX provide information that is usually available when trapping COM exceptions. You are free to put as much information as you need to in the detail tag and still be compliant to the SOAP standard.<br />
<br />
You can find a sample of each of these files (the request, the response and the error) in the Web directory included in the sample code. <br />
<br />
Pros and cons<br />
<br />
As any technology, SOAP comes with its sets of pros and cons.<br />
<br />
Simplicity and the fact that is becoming an industry accepted standard are probably the most important two pros for SOAP but another critical element plays a major role when developing internet application: scalability. SOAP is commonly used on top of HTTP although almost any other transport mechanisms can be used. When it's used like this and the stateless HTTP request/response model is maintained, SOAP provides a higher scalability than any other protocol (COM's DCE-RPC, Corba's IIOP or Java's JRMP). There are multiple reasons behind this statement but the most important is the fact that HTTP is stateless in nature. <br />
<br />
You can read more about this in the book "Understanding SOAP" mentioned at the end of this article. I'd also like to mention that using SOAP in a browser-based application could lead to unprecedented results in terms of ease of coding and functionality. For instance, instead of building URL strings such as http://myserver/ GetQuote?Symbol=BORL, more natural and object oriented calls such as StockServer.GetQuote('BORL') can now be easily performed.<br />
<br />
On the server side the result is similar: the need to access the Form or QueryString properties of the Request object becomes superfluous and you can let the SOAP listeners do the job for you. You only need to code your COM/Corba objects and the activation is taken care of by SOAP .<br />
<br />
Where SOAP falls short today is in security and data compression. XML is a textual representation of information and if the network you are running on is not secure, packets are extremely easy to sniff and then read with an application as simple as Notepad.<br />
<br />
XML and the SOAP convention for packaging messages add a lot of extra overhead.<br />
<br />
The example above demonstrated how costly sending a simple floating point number became (357 bytes). This is obviously an extreme example and sending such a small packet wouldn't really affect performances that much.<br />
<br />
Conclusion<br />
<br />
SOAP won't replace technologies like COM or Corba for in-house development for a long time, if ever. These technologies and the tools built on top of them deliver wider functionality than what SOAP offers today. Application servers such as Borland AppServer or Microsoft Transaction Server allow object pooling, just in time activation and much more. SOAP is mostly meant as an Internet lingua franca . Its stateless nature perfectly fits the Internet. LAN based application usually don't suffer of bandwidth limits, reliable communication or other problems as much as a wide area connection does.<br />
<br />
Its simplicity and the fact that is quickly becoming a standard are key factors.<br />
<br />
SOAP is the perfect candidate for those areas in which a system needs to exchange data or to use services provided by third parties. SOAP-enabled web services will lead to a more inter operable and collaborative Internet, which in turn may make development easier, less bug-prone and ultimately standardized.<br />
<br />
Resources<br />
<br />
If you want to know more about SOAP, the following resources may be very helpful:<br />
<br />
The SOAP specification (version 1.1) is located at http://www.w3.org/TR/2000/NOTE-SOAP-20000508/<br />
<br />
The Microsoft SOAP SDKs and other interesting articles can be found at http://www.msdn.microsoft.com/xml/default.asp<br />
<br />
The Java based IBM Web Services Toolkit runtime environment can be found at http://www.alphaworks.ibm.com/tech/webs ervicestoolkit<br />
<br />
The book &#8220;Understanding SOAP" written by Scrinber and Stiver and published by Sams is a great and detailed source of information on this topic.<br />
<br />
Special thanks<br />
<br />
I want to express my most sincere gratitude to John Beyer, Renzo Barduagni, Dave Nottage and Mark Chambers for helping me in reviewing this article and in providing excellent feedback.Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-20568896304162423702011-06-20T15:00:00.002-07:002011-06-25T03:31:42.154-07:00MySQL and Delphi
<br/>
Problem/Question/Abstract:<br/>
<br/>
I've always wanted a better way to interface with my favorite (I would argue the best) database and Delphi - and after much searching I bring you an excellent and sensible way to do it.<br/>
<br/>
Answer:<br/>
<br/>
This is based on the Open source MySQL connector "Objects".<br/>
<br/>
To start with you'll need Delphi of course - I believe this will work with 5 pro and higher although I've only used it with 7. Also I assume you have or have access to a properly configured and working MySQL server. If you don't there are plenty of excellent tutorials available. I'll also assume you have moderate knowledge of Delphi and can navigate, add buttons and all that basic stuff.<br/>
<br/>
First also need a copy of the actual connector objects. Which can be found at:<br/>
http://sourceforge.net/projects/directsql/<br/>
http://prdownloads.sourceforge.net/directsql/DirectMysqlObjects.zip?download <br/>
<br/>
If your interested there is also a demo which shows off its capabilities which can be found:<br/>
http://prdownloads.sourceforge.net/directsql/DemoObjectsWin.zip?download <br/>
<br/>
<br/>
To use the MySQL objects - simply unzip the contents of the zip you just downloaded into {Delphi}/lib/ folder.<br/>
<br/>
Now to use them all you need to do is add a couple of things to the uses of your interface:<br/>
uMySqlVio, uMysqlCT, uMysqlClient, uMysqlHelpers <br/>
<br/>
Its as easy as that!<br/>
<br/>
I suggest trying to compile your application after adding the "uses" for the first time to make sure Delphi can find them okay. Now I'll run through a quick tutorial on how to use the library to get you started.<br/>
<br/>
<br/>
Connection Example<br/>
<br/>
First add "MySQLClient: TMySQLClient;" to your main form's public. This will make the actual client that you'll do all the work with.<br/>
<br/>
Also add "MySQLResult: TMysqlResult;" to your main form's public as well. This will create an 'instance' of the MySQL result type for "catching" queries and other stuff that you'll want a result from.<br/>
<br/>
Great, so now the naming is done we'll add some code to actually connect to your database. Add this code to your form's OnCreate procedure (double click on your form):<br/>
MySQLClient := TMySQLClient.Create;<br/>
<br/>
Next add the following to the OnDestroy procedure:<br/>
MySQLClient.Free;<br/>
if MySQLResult <> nil then<br/>
MySQLResult.Free;<br/>
<br/>
Okay, now make a new button on your form and give it the caption of "Connect". To get it to actually connect first we'll need to define a few things like the host and user and stuff. You can either "hard code" the values (or read from your own config files / registry or whatever) or use edit boxes and such. Since this is a simple tutorial I'll leave the reading in values from cfg files up to you and use the easiest which is just a few edit boxes on your form.<br/>
<br/>
Add 5 edit boxes to your form and 3 check boxes. For quick reference label (leave the names the same) them<br/>
Edit1 - Host<br/>
Edit2 - Port<br/>
Edit3 - User<br/>
Edit4 - Password<br/>
Edit5 - Db<br/>
Check1 - Use named pipes<br/>
Check2 - Use SSL<br/>
Check3 - Compress<br/>
<br/>
Now add the following code to your OnClick procedure for the connect button you added earlier:<br/>
MySQLClient.Host := Edit1.Text;<br/>
MySQLClient.port := StrToInt(Edit2.text);<br/>
MySQLClient.user := Edit3.text;<br/>
MySQLClient.password := Edit4.text;<br/>
MySQLClient.Db := Edit5.Text;<br/>
MySQLClient.UseNamedPipe := CheckBox1.Checked;<br/>
MySQLClient.UseSSL := CheckBox2.Checked;<br/>
MySQLClient.Compress := CheckBox3.Checked;<br/>
<br/>
if MySQLClient.Connect then ShowMessage('connected ok!')<br/>
else ShowMessage('Somthing went wrong!");<br/>
<br/>
Or instead of the big chunk of text you can use:<br/>
if FMysql.Connect(Edit1.Text, Edit3.Text, Edit4.Text, 'db', StrToInt(Edit2.text), '', false, 0) then ShowMessage('connected ok!')<br/>
else ShowMessage('Somthing went wrong!");<br/>
<br/>
But its much easier for the second to go wrong, and harder to figure out what went wrong.<br/>
<br/>
Now run your program, fill in the edit boxes and see if it works!<br/>
<br/>
I'm assuming it did - so lets move along, almost there.<br/>
<br/>
Now we come to actually making the query - which is just like a query in any other language or interface. When you make a new query you need to assign the result to MySQLResult and use MySQLClient to run the query. There are 3 parameters, the query, if you want it to save the result, a boolean to store if it executed ok:<br/>
MySQLResult := MySQLClient.Query('SELECT * FROM users WHERE username=''username'' and password=''pass''', True, OK); <br/>
<br/>
(just a quick note for the inexperienced - often you'll need to use a ' in a sql query (ie - select * from user where name = 'joe bloggs') - which also signifies to Delphi that the string you are making has ended and will make it "freak out"(TM) - so there thankfully is an easy way around it, which is simply to wherever you need a ' in a string put two together - so select * from user where name = 'joe bloggs' would be 'select * from user where name = ''joe bloggs''')<br/>
<br/>
Now that you have the result of the query there's all sorts of things you can do with it. Have a go at browsing through the list of properties and procedures available. But to get you started - to get a field by using its name:<br/>
MySQLResult.FieldValueByName('username'); <br/>
<br/>
Hint for a login type script - <br/>
if (MySQLResult.FieldValueByName('username') <> 'dummy_username') or (MySQLResult.FieldValueByName('password') <> 'dummy_pass') then ...<br/>
<br/>
<br/>
So that's it - I hope that all helped - if you have any problems or questions or feedback feel free to e-mail me - ipvariance@hotmail.com.<br/>
<br/>
Special thanks to "Dumbass" who wrote the page where I first found the open source MySQL connector libraries.<br/>
<br/>
<br/>
<br/>
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-88259497977975269042011-06-19T15:00:00.002-07:002011-06-25T03:31:44.427-07:00Outlook from Delphi
<br/>
Problem/Question/Abstract:<br/>
<br/>
Outlook from Delphi<br/>
<br/>
Answer:<br/>
<br/>
Automating Microsoft Outlook <br/>
<br/>
Microsoft Office 97 appears to be five well-integrated applications. It is, in fact, much more. Office 97 was created using Microsoft's Component Object Model (COM). The Office applications are composed of a series of COM servers you can access from your Delphi applications using Automation (formerly know as OLE Automation). Beginning with Outlook 98, this article series will explore the object model of each of the office applications - and how you can use them from Delphi.<br/>
<br/>
The Outlook object model consists of objects and collections of objects (see Figure 1). The top-level object in Outlook 98 is the Application object. The Application object is the root of the object tree and provides access to all the other Outlook objects. The Application object is unique in that it's the only object you can gain access to by calling CreateOleObject from a Delphi (or any other) application. Next comes the NameSpace object, which provides access to a data source. The only available data source in Outlook 98 is the MAPI message store.<br/>
<br/>
<br/>
Figure 1: The Outlook object model.<br/>
<br/>
The MAPIFolders collection is just that - a collection of MAPI folders. You can think of collections as arrays of objects, somewhat like a Delphi TList. However, collection objects can be referenced by name or number. The MAPIFolder object in Figure 1 represents one of the folders in the MAPIFolders collection. Each MAPIFolder contains a Folders collection, and each of these contains an Items collection that contains the items appropriate to that folder. For example, the Contacts folder contains contact items.<br/>
<br/>
Figure 2 shows the main form of a Delphi project that displays the MAPIFolders collection, the Folders collection of the MAPI Personal folder, and the Items in the Contacts folder. Listing One displays the code from the Open Outlook button's OnClick event handler.<br/>
<br/>
<br/>
Figure 2: The MAPI Folders collection displayed in a Delphi form.<br/>
<br/>
The code in Listing One begins by declaring four Variant variables for use as references to various Outlook objects. The call to CreateOleObject loads the Outlook server and returns a reference to the Application object. The parameter passed to CreateOleObject, Outlook.Application, is the class name Outlook registers itself as when it's installed. Using the Application object you can get a reference to any other Outlook object.<br/>
<br/>
Calling the Application object's GetNameSpace method returns a reference to the NameSpace passed as a parameter. Using the MAPI NameSpace reference variable, Mapi, the code loops through the MAPIFolders collection and adds the name of each folder to the MapiList listbox. As with all objects in object-oriented programming, Outlook objects have properties, methods, and events. The Count property of the Folders collection is used to limit the number of times the for loop executes. All collections have a Count property to provide the number of objects in the collection. Each Folder in the MAPIFolders collection also has a Name property.<br/>
<br/>
As you can see in Figure 2, the MAPIFolders collection contains two folders, Microsoft Mail Shared Folders and Personal Folders. The following statement gets a reference to the Personal Folders collection from the MAPIFolders collection. While the for loop that displayed the names of the MAPI Folders accessed the MAPIFolders collection by number, the statement:<br/>
<br/>
Personal := Mapi.Folders('Personal Folders');<br/>
<br/>
indexes the collection by name. The next for loop uses the reference to the Personal Folder to display the names of all the folders in its Folders collection in the second listbox in Figure 2. The code then gets a reference to the Contacts folder and uses it to loop through the Contacts folder's Items collection. One of the properties of a Contact item is FullName; this property is added to the third listbox to display the names of the contacts.<br/>
<br/>
Clearly, the secret to working with Outlook 98 from your Delphi applications is understanding the Outlook object hierarchy and the properties, methods, and events of each object. Outlook 97 includes a Help file, VBAOUTL.HLP, that contains this information; however, I have been unable to find it on the Outlook 98 CD. Fortunately, very little has changed in Outlook 98. (Outlook 2000 is a different story, and will be the topic of a future article.) <br/>
<br/>
Working with Contacts<br/>
<br/>
Listing Two shows the OnClick event handler from the LoadTbl project that accompanies this article. This code demonstrates how to search the Outlook Contacts folder for the records you wish to select and copy them to a database table.<br/>
<br/>
As in the example shown in Listing One, this one begins by getting the Application object and the MAPI NameSpace object. Next, a reference is obtained using the statement:<br/>
<br/>
ContactItems := Mapi.Folders('Personal Folders').<br/>
Folders('Contacts').Items;<br/>
<br/>
This statement demonstrates how you can chain objects together using dot notation to get a reference to a low-level object without having to get individual references to each of the higher level objects. In this case, five levels of intervening objects are specified to get to the Items object of the Contacts folder. These objects are:<br/>
<br/>
The MAPI NameSpace object <br/>
The Folders collection <br/>
The Personal Folders object <br/>
The Folders collection <br/>
The Contacts object <br/>
<br/>
You can use this notation to get a reference to any Outlook object in a single statement. The next new feature of this method is the call to the Find method of the ContactItems collection. Almost all collection objects have a Find method you can use to locate a particular item in the collection using one or more of its properties. In this example, the statement:<br/>
<br/>
CurrentContact := ContactItems.Find(' [CompanyName] = ' +<br/>
QuotedStr('Borland International'));<br/>
<br/>
finds the first contact item where the value of the CompanyName property is equal to Borland International. If no matching item is found, the Variant CurrentContact will be empty. The while loop inserts a new record into the database table, and assigns each of the Contact item's properties to the corresponding field in the table. The while loop continues until CurrentContact is empty, indicating that no more items matching the search criteria can be found. At the end of the while loop, the call to FindNext finds the next matching record, if there is one. If no record is found, CurrentContact is set to empty and the loop terminates.<br/>
<br/>
Creating new Contact folders and records is just as easy. Suppose you want to copy all your Contact records for Borland employees into a new folder. The code in Listing Three from the NewFolder sample project will do the job.<br/>
<br/>
This method begins by getting the Application, MAPI NameSpace, and Contacts folder's Items object. Next, it uses a for loop to scan the Folders collection looking for the Borland Contacts folder. If the folder is found, its number is assigned to the ToRemove variable. The Borland Contacts folder is deleted by calling the Folders collection's Remove method and passing the ToRemove variable as the parameter.<br/>
<br/>
Next, a call to the Folders collection's Add method creates the Borland Contacts folder. Add takes two parameters. The first is the name of the folder to be created. The second parameter is the folder type and can be olFolderCalendar, olFolderContacts, olFolderInbox, olFolderJournal, olFolderNotes, or olFolderTasks. To find the values of these and any other constants you need, search the VBAOUTL.HLP file for Microsoft Outlook Constants. The next statement gets a reference to the new Borland Contacts folder and stores it in the BorlandContacts variable.<br/>
<br/>
A call to the Contacts folder's Items collection's Find method locates the first record for a Borland employee. The while loop is used to iterate through all the Borland employees in the Contacts folder. At the top of the loop a new record is added to the Borland Contacts folder by calling the folder's Items collection's Add method.<br/>
<br/>
Add takes no parameters; it simply inserts a new empty record and returns a reference to the new record, which is saved in the NewContact variable. The statements that follow assign values from the existing record to the new one. Finally, the new record's Save method is called. This is a critical step. If you don't call Save, no errors will be generated - but there will be no new records in the folder. When the while loop terminates Outlook is closed by assigning the constant Unassigned to the OutlookApp variable.<br/>
<br/>
Other Outlook Objects<br/>
<br/>
The Folders collection of the Personal Folder object contains the following folders:<br/>
<br/>
Deleted Items <br/>
Inbox <br/>
Outbox <br/>
Sent Items <br/>
Calendar <br/>
Contacts <br/>
Journal <br/>
Notes <br/>
Tasks <br/>
Drafts <br/>
<br/>
You can work with the Items collection of any of these folders using the same code shown for working with Contacts. Only the properties of the items are different. Listing Four shows a method that copies to a Paradox table all appointments that are all-day events and whose start date is greater than 4/27/99. This example copies the Start, End, Subject and BusyStatus properties to the table. Note that this example uses a more sophisticated find expression than previous examples. Find supports the >, <, >=, <=, = and <> operators, as well as the logical operators and, or, and not, which allows you to construct complex search expressions.<br/>
<br/>
Conclusion<br/>
<br/>
Delphi applications can easily act as Automation clients, allowing your applications to interact with the Microsoft Office Suite applications in any way you wish. Using Outlook you can extract contact information to update a central database, add new contacts derived from other sources, create new folders, and add items of any type. One of Outlook's limitations is its lack of a powerful reporting tool. With a Delphi application you can provide much more powerful reporting capabilities for Outlook data. With a basic understanding of the Outlook object model and a copy of the VBAOUTL.HLP help file you are well on your way.<br/>
<br/>
<br/>
Begin Listing One - Displaying Outlook objects<br/>
procedure TForm1.OpenBtnClick(Sender: TObject);<br/>
var<br/>
OutlookApp,<br/>
Mapi,<br/>
Contacts,<br/>
Personal: Variant;<br/>
I: Integer;<br/>
begin<br/>
{ Get the Outlook Application object. }<br/>
OutlookApp := CreateOleObject('Outlook.Application');<br/>
{ Get the MAPI NameSpace object. }<br/>
Mapi := OutlookApp.GetNameSpace('MAPI');<br/>
{ Loop through the MAPI Folders collection and add the<br/>
Name of each folder to the listbox. }<br/>
for I := 1 to Mapi.Folders.Count do<br/>
MapiList.Items.Add(Mapi.Folders(I).Name);<br/>
{ Get the Personal folder from the MAPI folders<br/>
collection. }<br/>
Personal := Mapi.Folders('Personal Folders');<br/>
{ Loop through the Personal Folders Collection and add<br/>
the name of each folder to the listbox. }<br/>
for I := 1 to Personal.Folders.Count do<br/>
PersonalList.Items.Add(Personal.Folders(I).Name);<br/>
{ Get the Contacts folder from the Personal Folders<br/>
collection. }<br/>
Contacts := Personal.Folders('Contacts');<br/>
{ Loop through the Contacts folder's Items collection<br/>
and add the FullName property of each Item<br/>
to the listbox. }<br/>
for I := 1 to Contacts.Items.Count do<br/>
ContactsList.Items.Add(Contacts.Items(I).FullName);<br/>
{ Close Outlook. }<br/>
OutlookApp := Unassigned;<br/>
end;<br/>
End Listing One<br/>
<br/>
Begin Listing Two - Searching for contacts<br/>
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);<br/>
var<br/>
OutlookApp,<br/>
Mapi,<br/>
ContactItems,<br/>
CurrentContact: Variant;<br/>
begin<br/>
{ Get the Outlook Application object. }<br/>
OutlookApp := CreateOleObject('Outlook.Application');<br/>
{ Get the MAPI NameSpace object. }<br/>
Mapi := OutlookApp.GetNameSpace('MAPI');<br/>
{ Get the Items collection from the Contacts folder. If<br/>
you don't do this, FindNext will not work. }<br/>
ContactItems := Mapi.Folders('Personal Folders').<br/>
Folders('Contacts').Items;<br/>
{ Load Contacts into table. }<br/>
with ContactTable do<br/>
begin<br/>
EmptyTable;<br/>
Open;<br/>
DisableControls;<br/>
CurrentContact :=<br/>
ContactItems.Find('[CompanyName] = ' +<br/>
QuotedStr('Borland International'));<br/>
while not VarIsEmpty(CurrentContact) do<br/>
begin<br/>
Insert;<br/>
FieldByName('EntryId').AsString :=<br/>
CurrentContact.EntryId;<br/>
FieldByName('LastName').AsString :=<br/>
CurrentContact.LastName;<br/>
FieldByName('FirstName').AsString :=<br/>
CurrentContact.FirstName;<br/>
FieldByName('CompanyName').AsString :=<br/>
CurrentContact.CompanyName;<br/>
FieldByName('BusAddrStreet').AsString :=<br/>
CurrentContact.BusinessAddressStreet;<br/>
FieldByName('BusAddrPOBox').AsString :=<br/>
CurrentContact.BusinessAddressPostOfficeBox;<br/>
FieldByName('BusAddrCity').AsString :=<br/>
CurrentContact.BusinessAddressCity;<br/>
FieldByName('BusAddrState').AsString :=<br/>
CurrentContact.BusinessAddressState;<br/>
FieldByName('BusAddrPostalCode').AsString :=<br/>
CurrentContact.BusinessAddressPostalCode;<br/>
FieldByName('BusinessPhone').AsString :=<br/>
CurrentContact.BusinessTelephoneNumber;<br/>
Post;<br/>
CurrentContact := ContactItems.FindNext;<br/>
end; // while<br/>
EnableControls;<br/>
end; // with<br/>
{ Close Outlook. }<br/>
OutlookApp := Unassigned;<br/>
end;<br/>
End Listing Two<br/>
<br/>
Begin Listing Three - Creating a Contacts folder and new contacts<br/>
procedure TCreateFolderFrom.CreateBtnClick(Sender: TObject);<br/>
const<br/>
olFolderContacts = 10;<br/>
olContactItem = 2;<br/>
var<br/>
OutlookApp,<br/>
Mapi,<br/>
NewContact,<br/>
BorlandContacts,<br/>
ContactItems,<br/>
CurrentContact: Variant;<br/>
I,<br/>
ToRemove: Integer;<br/>
begin<br/>
{ Get the Outlook Application object. }<br/>
OutlookApp := CreateOleObject('Outlook.Application');<br/>
{ Get the MAPI NameSpace object. }<br/>
Mapi := OutlookApp.GetNameSpace('MAPI');<br/>
{ Get the Items collection from the Contacts folder. If<br/>
you don't do this,FindNext will not work. }<br/>
ContactItems := Mapi.Folders('Personal Folders').<br/>
Folders('Contacts').Items;<br/>
{ Remove the test folder. }<br/>
ToRemove := 0;<br/>
for I := 1 to Mapi.Folders('Personal Folders').<br/>
Folders.Count do<br/>
if Mapi.Folders('Personal Folders').Folders(I).Name =<br/>
'Borland Contacts' then<br/>
begin<br/>
ToRemove := I;<br/>
Break;<br/>
end; // if<br/>
if ToRemove <> 0 then<br/>
Mapi.Folders('Personal Folders').<br/>
Folders.Remove(ToRemove);<br/>
{ Create a new folder. }<br/>
Mapi.Folders('Personal Folders').<br/>
Folders.Add('Borland Contacts', olFolderContacts);<br/>
BorlandContacts := Mapi.Folders('Personal Folders').<br/>
Folders('Borland Contacts');<br/>
{ Load Contacts into new folder. }<br/>
CurrentContact := ContactItems.Find('[CompanyName] = ' +<br/>
QuotedStr('Borland International'));<br/>
while not VarIsEmpty(CurrentContact) do<br/>
begin<br/>
{ Add a new item to the folder. }<br/>
NewContact := BorlandContacts.Items.Add;<br/>
{ Assign values to the fields in the item record. }<br/>
NewContact.FullName := 'John Doe';<br/>
NewContact.LastName := CurrentContact.LastName;<br/>
NewContact.FirstName := CurrentContact.FirstName;<br/>
NewContact.CompanyName := CurrentContact.CompanyName;<br/>
NewContact.BusinessAddressStreet :=<br/>
CurrentContact.BusinessAddressStreet;<br/>
NewContact.BusinessAddressPostOfficeBox :=<br/>
CurrentContact.BusinessAddressPostOfficeBox;<br/>
NewContact.BusinessAddressCity :=<br/>
CurrentContact.BusinessAddressCity;<br/>
NewContact.BusinessAddressState :=<br/>
CurrentContact.BusinessAddressState;<br/>
NewContact.BusinessAddressPostalCode :=<br/>
CurrentContact.BusinessAddressPostalCode;<br/>
NewContact.BusinessTelephoneNumber :=<br/>
CurrentContact.BusinessTelephoneNumber;<br/>
{ Save the new record. }<br/>
NewContact.Save;<br/>
{ Find the next record in the Contacts folder. }<br/>
CurrentContact := ContactItems.FindNext;<br/>
end; // while<br/>
{ Close Outlook. }<br/>
OutlookApp := Unassigned;<br/>
end;<br/>
End Listing Three<br/>
<br/>
Begin Listing Four - Reading Calendar folder<br/>
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);<br/>
var<br/>
OutlookApp,<br/>
Mapi,<br/>
ApptItems,<br/>
CurrentAppt: Variant;<br/>
begin<br/>
{ Get the Outlook Application object. }<br/>
OutlookApp := CreateOleObject('Outlook.Application');<br/>
{ Get the MAPI NameSpace object. }<br/>
Mapi := OutlookApp.GetNameSpace('MAPI');<br/>
{ Get the Items collection from the Contacts folder. If<br/>
you don't do this, FindNext will not work. }<br/>
ApptItems := Mapi.Folders('Personal Folders').<br/>
Folders('Calendar').Items;<br/>
{ Load Contacts into table. }<br/>
with ApptTable do<br/>
begin<br/>
EmptyTable;<br/>
Open;<br/>
DisableControls;<br/>
CurrentAppt := ApptItems.Find('[Start] > ' +<br/>
'"4/27/99" and [AllDayEvent] = True');<br/>
while not VarIsEmpty(CurrentAppt) do<br/>
begin<br/>
Insert;<br/>
FieldByName('Start').AsDateTime := CurrentAppt.Start;<br/>
FieldByName('Subject').AsString :=<br/>
CurrentAppt.Subject;<br/>
FieldByName('End').AsDateTime := CurrentAppt.End;<br/>
FieldByName('Busy').AsBoolean :=<br/>
CurrentAppt.BusyStatus;<br/>
Post;<br/>
CurrentAppt := ApptItems.FindNext;<br/>
end; // while<br/>
EnableControls;<br/>
end; // with<br/>
{ Close Outlook. }<br/>
OutlookApp := Unassigned;<br/>
end;<br/>
End Listing Four<br/>
<br/>
<br/>
Component Download: outlook_from_delphi.zip
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-28673671664008342802011-06-18T15:00:00.002-07:002011-06-25T03:31:45.930-07:00How to create a transparent TPanel
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to create a transparent TPanel<br/>
<br/>
Answer:<br/>
<br/>
Solve 1:<br/>
<br/>
Particularly note the SetParent bit. It works even with movement. It should even work in Delphi 1, as it doesn't use the Win32 non-rectangular-window method for creating transparency. The code is simple so can be easily retro-fitted to any control that you wished were transparent. I put this together in ten minutes, so it needs proper testing to make sure it doesn't cause any problems, but here it is. Create one on a form, and drag it about over some edits, combo boxes etc. (and TImages and you'll get major flicker).<br/>
<br/>
type<br/>
TTransparentPanel = class(TPanel)<br/>
private<br/>
procedure SetParent(AParent: TWinControl); override;<br/>
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_EraseBkGnd;<br/>
protected<br/>
procedure CreateParams(var Params: TCreateParams); override;<br/>
procedure Paint; override;<br/>
public<br/>
constructor Create(AOwner: TComponent); override;<br/>
procedure Invalidate; override;<br/>
end;<br/>
<br/>
constructor TTransparentPanel.Create(AOwner: TComponent);<br/>
begin<br/>
inherited Create(AOwner);<br/>
ControlStyle := ControlStyle - [csOpaque];<br/>
end;<br/>
<br/>
procedure TTransparentPanel.CreateParams(var Params: TCreateParams);<br/>
begin<br/>
inherited CreateParams(Params);<br/>
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;<br/>
end;<br/>
<br/>
procedure TTransparentPanel.Paint;<br/>
begin<br/>
Canvas.Brush.Style := bsClear;<br/>
Canvas.Rectangle(0, 0, Width, Height);<br/>
Canvas.TextOut(Width div 2, Height div 2, 'Transparent');<br/>
end;<br/>
<br/>
procedure TTransparentPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);<br/>
begin<br/>
{Do Nothing}<br/>
Message.Result := 1;<br/>
end;<br/>
<br/>
procedure TTransparentPanel.SetParent(AParent: TWinControl);<br/>
begin<br/>
inherited SetParent(AParent);<br/>
{The trick needed to make it all work! I don't know if changing the parent's <br/>
style is a good idea, but it only removes the WS_CLIPCHILDREN style which shouldn't cause any problems.}<br/>
if Parent <> nil then<br/>
SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong<br/>
(Parent.Handle, GWL_STYLE) and not WS_ClipChildren);<br/>
end;<br/>
<br/>
procedure TTransparentPanel.Invalidate;<br/>
var<br/>
Rect: TRect;<br/>
begin<br/>
Rect := BoundsRect;<br/>
if (Parent <> nil) and Parent.HandleAllocated then<br/>
InvalidateRect(Parent.Handle, @Rect, True)<br/>
else<br/>
inherited Invalidate;<br/>
end;<br/>
<br/>
<br/>
Solve 2:<br/>
<br/>
unit TransparentPanel;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;<br/>
<br/>
type<br/>
TTransparentPanel = class(TPanel)<br/>
private<br/>
{ Private declarations }<br/>
FBackground: TBitmap;<br/>
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;<br/>
protected<br/>
{ Protected declarations }<br/>
procedure CaptureBackground;<br/>
procedure Paint; override;<br/>
public<br/>
{ Public declarations }<br/>
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;<br/>
property Canvas;<br/>
constructor Create(aOwner: TComponent); override;<br/>
destructor Destroy; override;<br/>
published<br/>
{ Published declarations }<br/>
end;<br/>
<br/>
procedure Register;<br/>
<br/>
implementation<br/>
<br/>
procedure Register;<br/>
begin<br/>
RegisterComponents('PBGoodies', [TTransparentPanel]);<br/>
end;<br/>
<br/>
procedure TTransparentPanel.CaptureBackground;<br/>
var<br/>
canvas: TCanvas;<br/>
dc: HDC;<br/>
sourcerect: TRect;<br/>
begin<br/>
FBackground := TBitmap.Create;<br/>
with Fbackground do<br/>
begin<br/>
width := clientwidth;<br/>
height := clientheight;<br/>
end;<br/>
sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);<br/>
sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);<br/>
dc := CreateDC('DISPLAY', nil, nil, nil);<br/>
try<br/>
canvas := TCanvas.Create;<br/>
try<br/>
canvas.handle := dc;<br/>
Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);<br/>
finally<br/>
canvas.handle := 0;<br/>
canvas.free;<br/>
end;<br/>
finally<br/>
DeleteDC(dc);<br/>
end;<br/>
end;<br/>
<br/>
constructor TTransparentPanel.Create(aOwner: TComponent);<br/>
begin<br/>
inherited;<br/>
ControlStyle := controlStyle - [csSetCaption];<br/>
end;<br/>
<br/>
destructor TTransparentPanel.Destroy;<br/>
begin<br/>
FBackground.free;<br/>
inherited;<br/>
end;<br/>
<br/>
procedure TTransparentPanel.Paint;<br/>
begin<br/>
if csDesigning in ComponentState then<br/>
inherited<br/>
{would need to draw frame and optional caption here do not call<br/>
inherited, the control fills its client area if you do}<br/>
end;<br/>
<br/>
procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);<br/>
begin<br/>
if Visible and HandleAllocated and not (csDesigning in ComponentState) then<br/>
begin<br/>
Fbackground.Free;<br/>
Fbackground := nil;<br/>
Hide;<br/>
inherited;<br/>
Parent.Update;<br/>
Show;<br/>
end<br/>
else<br/>
inherited;<br/>
end;<br/>
<br/>
procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);<br/>
var<br/>
canvas: TCanvas;<br/>
begin<br/>
if csDesigning in ComponentState then<br/>
inherited<br/>
else<br/>
begin<br/>
if not Assigned(FBackground) then<br/>
Capturebackground;<br/>
canvas := TCanvas.create;<br/>
try<br/>
canvas.handle := msg.DC;<br/>
canvas.draw(0, 0, FBackground);<br/>
finally<br/>
canvas.handle := 0;<br/>
canvas.free;<br/>
end;<br/>
msg.result := 1;<br/>
end;<br/>
end;<br/>
<br/>
end.<br/>
<br/>
<br/>
Solve 3:<br/>
<br/>
This panel will be transparent only at runtime.<br/>
<br/>
{ ... }<br/>
type<br/>
TMyPopUpTransPanel = class(TPanel)<br/>
protected<br/>
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;<br/>
procedure WndProc(var Message: TMessage); override;<br/>
procedure CreateParams(var Params: TCreateParams); override;<br/>
procedure Paint; override;<br/>
end;<br/>
{ ... }<br/>
<br/>
procedure TMyPopUpTransPanel.CMHitTest(var Message: TCMHitTest);<br/>
begin<br/>
Message.Result := Windows.HTNOWHERE;<br/>
end;<br/>
<br/>
procedure TMyPopUpTransPanel.WndProc(var Message: TMessage);<br/>
var<br/>
XControl: TControl;<br/>
XPos: TPoint;<br/>
begin<br/>
if not (csDesigning in ComponentState) and ((Message.Msg >= WM_MOUSEFIRST)<br/>
and (Message.Msg <= WM_MOUSELAST)) then<br/>
begin<br/>
XPos := ClientToScreen(POINT(TWMMouse(Message).XPos, TWMMouse(Message).YPos));<br/>
XControl := Parent.ControlAtPos(POINT(TWMMouse(Message).XPos +<br/>
Left, TWMMouse(Message).YPos + Top), true, true);<br/>
if Assigned(XControl) and (XControl is TWinControl) then<br/>
begin<br/>
XPos := TWinControl(XControl).ScreenToClient(XPos);<br/>
TWMMouse(Message).XPos := XPos.X;<br/>
TWMMouse(Message).YPos := XPos.Y;<br/>
PostMessage(TWinControl(XControl).Handle, Message.Msg,<br/>
Message.WParam, Message.LParam);<br/>
end<br/>
else<br/>
begin<br/>
XPos := Parent.ScreenToClient(XPos);<br/>
TWMMouse(Message).XPos := XPos.X;<br/>
TWMMouse(Message).YPos := XPos.Y;<br/>
PostMessage(Parent.Handle, Message.Msg, Message.WParam, Message.LParam);<br/>
end;<br/>
Message.Result := 0;<br/>
end<br/>
else<br/>
inherited WndProc(Message);<br/>
end;<br/>
<br/>
procedure TMyPopUpTransPanel.CreateParams(var Params: TCreateParams);<br/>
begin<br/>
inherited CreateParams(Params);<br/>
if not (csDesigning in ComponentState) then<br/>
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;<br/>
end;<br/>
<br/>
procedure TMyPopUpTransPanel.Paint;<br/>
var<br/>
XBitMap: TBitMap;<br/>
XOldDC: HDC;<br/>
XRect: TRect;<br/>
begin<br/>
if (csDesigning in ComponentState) then<br/>
inherited Paint<br/>
else<br/>
begin<br/>
XRect := ClientRect;<br/>
XOldDC := Canvas.Handle;<br/>
XBitMap := TBitMap.Create;<br/>
try<br/>
XBitMap.Height := Height;<br/>
XBitMap.Width := Width;<br/>
Canvas.Handle := XBitMap.Canvas.Handle;<br/>
inherited Paint;<br/>
RedrawWindow(Parent.Handle, @XRect, 0, RDW_ERASE or RDW_INVALIDATE or<br/>
RDW_NOCHILDREN or RDW_UPDATENOW);<br/>
finally<br/>
Canvas.Handle := XOldDC;<br/>
Canvas.BrushCopy(XRect, XBitMap, XRect, Color);<br/>
XBitMap.Free;<br/>
end;<br/>
end;<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-20424670422897355782011-06-17T15:00:00.002-07:002011-06-25T03:31:48.601-07:00Installing BDE from BDEINST.CAB
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to install BDE from BDEINST.CAB file<br/>
<br/>
Answer:<br/>
<br/>
If you have taken a close look at the listing of the BDE installation directory (usually \Program Files\Borland\Common FIles\BDE), you've noticed there's a file called BDEINST.CAB. If BDEINST.CAB isn't present in the BDE folder, you probably chose not to let it be installed. As this tip requires this file, you might want to run install again and install only BDEINST.CAB. Anyway, let's get back to the tip.<br/>
<br/>
What is BDEINST.CAB?<br/>
<br/>
BDEINST.CAB is a cabinet (Microsoft's compression format) file that contains only one large file: BDEINST.DLL. This DLL contains a simple installation program along with all the necessary files for a basic install of BDE. It will correctly install BDE with the native drivers for Paradox, dBase, MS Access and FoxPro. It won't install drivers for SQL database servers. If all you need is a basic installation of BDE for supporting one of the forementioned databases, then BDEINST.CAB is the best choice for you.<br/>
<br/>
Given the problem InstallShield and Wise have with installing BDE 5, BDEINST.DLL has a great appeal, since it was created by the Borland folks and doesn't suffer from the same problems InstallShield and WISE do.<br/>
<br/>
There is, however, a drawback: BDEINST.DLL is a quite large file, so it's that good if you're deploying on floppy disks. There's a workaround for this problem and we'll get back to it later on.<br/>
<br/>
Using BDEINST.DLL<br/>
<br/>
In order to use BDEINST.DLL, all you have to do is to extract it from BDEINST.CAB. There are several ways this can be done. Two of them are: <br/>
<br/>
Using WinZip or another CAB-compatible archiver. Simply extract BDEINST.DLL from the CAB file.<br/>
Using Microsoft's EXTRACT utility that comes with Windows 9x and NT. From a DOS window, issue the command below (path is also shown):<br/>
<br/>
C:\Program Files\Borland\Common Files\BDE>EXTRACT /E BDEINST.CAB<br/>
<br/>
This will extract BDEINST.DLL to the current directory, since no destination dir was specified in the command line.<br/>
<br/>
The task now is to use the DLL. This is as simple as issuing the command line below:<br/>
<br/>
C:\WINDOWS\SYSTEM\REGSVR32.EXE /S CABINST.DLL<br/>
<br/>
If the command above fails, make sure you have REGSVR32.EXE on your machine. Not all machines have it, and, in case of deploying BDEINST.DLL, it's also a good idea to deploy REGSVR32.EXE. This file can be found in \WINDOWS\SYSTEM or \WINNT\SYSTEM32.<br/>
<br/>
A progress dialog box will popup indicating that the installation of BDE is going ok. This is all it takes to install BDE without needing any additional tool such as InstallShield or Wise.<br/>
<br/>
If you do not want to deploy REGSVR32.EXE, you can create a small VCL-less and formless application that simply calls DllRegisterServer from the DLL.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-78550883454003644812011-06-16T15:00:00.002-07:002011-06-25T03:31:49.300-07:00How to store records in a TList when their number is unknown until runtime
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to store records in a TList when their number is unknown until runtime<br/>
<br/>
Answer:<br/>
<br/>
To store a number of records ( probably number unknown until runtime ), one would use a Delphi TList object. TList is basically an array of pointers that grows as needed, up to 16K pointers can be stored in a TList. It will accept anything that even remotely looks like a pointer (a pointer is an address, normally of a bit of data that has been allocated from the heap, and needs 4 bytes to store the address). If you work with dynamically allocated data items you need to take care of releasing this memory to the system heap again if it is no longer needed. It is easy to forget this, especially if the data items are kept in a list. It is thus a good idea to derive a custom list class from TList that takes care of freeing the memory for the items it stores automatically.<br/>
<br/>
<br/>
type<br/>
TRecord = record { the record type }<br/>
{ ... }<br/>
end;<br/>
PRecord = ^TRecord; { pointer type for pointers to TRecords }<br/>
TRecordList = class(TList) { a customized version of TList to hold PRecord pointers }<br/>
private<br/>
procedure SetRecord(index: Integer; Ptr: PRecord);<br/>
function GetRecord(index: Integer): PRecord;<br/>
public<br/>
procedure Clear;<br/>
destructor Destroy; override;<br/>
property Records[i: Integer]: PRecord read GetRecord write SetRecord;<br/>
end;<br/>
<br/>
{Methods of TRecordList}<br/>
<br/>
procedure TRecordList.SetRecord(index: Integer; Ptr: PRecord);<br/>
var<br/>
p: PRecord;<br/>
begin<br/>
{ get the pointer currently in slot index }<br/>
p := Records[index];<br/>
if p <> Ptr then<br/>
begin<br/>
{ if it is different from the one we are asked to put into this slot, check if it is <> Nil. If so, dispose of the memory it points at! }<br/>
if p <> nil then<br/>
Dispose(p);<br/>
{ store the passed pointer into the slot }<br/>
Items[index] := Ptr;<br/>
end;<br/>
end;<br/>
<br/>
function TRecordList.GetRecord(index: Integer): PRecord;<br/>
begin<br/>
{ return the pointer in slot index, typecast to PRecord }<br/>
Result := PRecord(Items[index]);<br/>
end;<br/>
<br/>
procedure TRecordList.Clear;<br/>
var<br/>
i: Integer;<br/>
p: PRecord;<br/>
begin<br/>
{ dispose of the memory pointed to by all pointers in the list that are not Nil }<br/>
for i := 0 to Pred(Count) do<br/>
begin<br/>
p := Records[i];<br/>
if p <> nil then<br/>
Dispose(p);<br/>
end;<br/>
{ call the Clear method inherited from TList to set Count to 0 }<br/>
inherited Clear;<br/>
end;<br/>
<br/>
destructor TRecordList.Destroy;<br/>
begin<br/>
{ clear the list to dispose of any pointers still stored first }<br/>
Clear;<br/>
inherited Destroy;<br/>
end;<br/>
<br/>
<br/>
<br/>
All we did up to here was declaring types, lets put them to use now. First we need an instance of TRecordList to store pointers to dynamically allocated records in. That may be a field in a form, for example. Code to create and destroy the list has to be added to the forms OnCreate and OnDestroy handlers.<br/>
<br/>
<br/>
{ in a forms public section: }<br/>
RecordList: TRecordList;<br/>
<br/>
{ in the forms OnCreate handler }<br/>
RecordList := TRecordList.Create;<br/>
<br/>
{ in the forms OnDestroy handler }<br/>
RecordList.Free;<br/>
<br/>
<br/>
To add a record to the list you use code like this:<br/>
<br/>
<br/>
var<br/>
Ptr: PRecord; { local variable in a method }<br/>
<br/>
New(Ptr); { allocate a record on the heap }<br/>
with Ptr^ do<br/>
begin { note the caret to dereference the pointer }<br/>
{ put data into the fields of the record }<br/>
end;<br/>
recordIndex := RecordList.Add(Ptr);<br/>
<br/>
<br/>
You do this sequence for each record you need to store. Each record now resides at a specific slot in the list and you can access it via the index of this slot. Indices start at 0 and run to RecordList.Count-1.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-34111085365987499352011-06-15T15:00:00.002-07:002011-06-25T03:31:50.000-07:00How to prevent csOpaque child controls from flickering
<br/>
Problem/Question/Abstract:<br/>
<br/>
I have a TPaintBox that I use to draw a representation of the data the user is entering. It updates whenever the form is repainted or data is changed. This works fine. Using D5, I've noticed that when the user is moving the mouse around causing hints to pop up and down, it causes a tremendous amount of flicker. In part, this is caused by the fact that I clear the canvas before redrawing. Should I draw to an invisible paintbox and then copy to a TImage?<br/>
<br/>
Answer:<br/>
<br/>
{ Overrides the WM_ERASEBKGND message in TWinControl and TForm to prevent flicker of csOpaque child controls.<br/>
Unpublished; (c) 1999, David Best, davebest@usa.net<br/>
You are free to use this and derived works provided you acknowlege it's source in your code.}<br/>
<br/>
procedure WMEraseBkgndEx(WinControl: TWinControl; var Message: TWmEraseBkgnd);<br/>
var<br/>
i, Clip, SaveIndex: Integer;<br/>
begin<br/>
{ Only erase background if we're not doublebuffering or painting to memory }<br/>
with WinControl do<br/>
if not DoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam) then<br/>
begin<br/>
SaveIndex := SaveDC(Message.DC);<br/>
Clip := SimpleRegion;<br/>
if ControlCount > 0 then<br/>
begin<br/>
for i := 0 to ControlCount - 1 do<br/>
if not (Controls[i] is TWinControl) then<br/>
{child windows already excluded}<br/>
with Controls[i] do<br/>
begin<br/>
if (Visible or (csDesigning in ComponentState) and not<br/>
(csNoDesignVisible in ControlStyle))<br/>
and (csOpaque in ControlStyle) then<br/>
begin<br/>
Clip := ExcludeClipRect(Message.DC, Left, Top, Left +<br/>
Width, Top + Height);<br/>
if Clip = NullRegion then<br/>
break;<br/>
end;<br/>
end;<br/>
end;<br/>
if Clip <> NullRegion then<br/>
FillRect(Message.DC, ClientRect, Brush.Handle);<br/>
RestoreDC(Message.DC, SaveIndex);<br/>
end;<br/>
Message.Result := 1;<br/>
end;<br/>
<br/>
procedure TNoFlickerForm.WMEraseBkGnd(var msg: TWMEraseBkGnd);<br/>
begin<br/>
WMEraseBkgndEx(Self, msg);<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-49417603046752019512011-06-14T15:00:00.001-07:002011-06-25T03:31:51.583-07:00Delphi Frames
<br/>
Problem/Question/Abstract:<br/>
<br/>
Understanding Delphi 5's New Visual Container Class<br/>
<br/>
Answer:<br/>
<br/>
Delphi 5 introduces a new, visual container class that represents an important advance in rapid application development (RAD) programming. This class, TFrame, provides you with the ability to visually configure a set of one or more components, and then to easily reuse this configuration throughout your application. This capability is so powerful that Delphi 5's integrated development environment (IDE) was re-designed to make extensive use of frames. <br/>
<br/>
This article begins with a general discussion of what frames are, and what benefits they provide. It continues with a demonstration of how to create frames, and how to modify the properties of objects that appear on frame instances. Next, you'll learn how to create event handlers for frames, and how to override or extend these event handlers in frame instances. This article concludes by showing you how to add frames to the Component palette and the Object Repository, and the benefits of doing so. <br/>
<br/>
Overview of Frames<br/>
<br/>
There are two primary benefits of frames. The first is that, under certain circumstances, frames can dramatically reduce the amount of resources that need to be stored in a project. The second, and generally more important benefit, is that frames permit you to visually create objects that can be duplicated and extended. These happen to be the same two benefits that you enjoy with visual form inheritance (VFI). <br/>
<br/>
VFI permits you to create form objects that can be inherited from easily. The main limit to VFI is that you must use the form in an all-or-nothing fashion. Specifically, when you use VFI you always create an entirely new form. Frames, on the other hand, are more similar to panels in this respect. That is, a single form can contain two or more frames. Importantly, every frame maintains its relationship with the parent TFrame class, meaning that subsequent changes to the parent class are automatically inherited by the instances. Although you could achieve a similar effect using TPanel components, doing so would be a strictly code-based operation. That is, you would have to write the code to define the TPanel descendants manually. Frames, on the other hand, are designed visually, just like forms. <br/>
<br/>
Frames can also be thought of as sharing some similarities with component templates (a group of one or more components that are saved to the Component palette by selecting Component | Create Component Template). However, the similarities are limited to the fact that both component templates and frames are designed visually (unlike traditional component design, which is an exclusively code-based process). The differences between component templates and frames are actually very great. As you've already learned, a frame is an instance of a defining class, and, as such, is changed when the defining class is changed. By comparison, component templates are aggregates of components. A change to a component template has no effect on objects previously created from that template. <br/>
<br/>
Creating a Frame<br/>
<br/>
The following steps demonstrate how to create a frame (the code for this project is available for download; see end of article for details). <br/>
<br/>
Select File | New Application to create a new project. <br/>
<br/>
Select File | New Frame to create a new frame. On this frame, place three labels and three DBEdits. Also place a DBNavigator and a DataSource (as shown in Figure 1). Set the captions of the labels to ID, First Name, and Last Name. Set the DataSource property of each DBEdit and the DBNavigator to DataSource1. <br/>
<br/>
With this frame still selected, set its Name property to NameFrame. (More so than other objects, it's particularly important to give a frame a meaningful name.) Finally, save the frame by selecting File | Save As. In this case, save the frame using the file name NAMEFRAM.PAS. <br/>
<br/>
<br/>
<br/>
Figure 1: A simple frame for displaying an ID number, as well as a first and last name. <br/>
<br/>
That's all there is to creating a frame. The following section demonstrates how to put it to use. <br/>
<br/>
Using a Frame<br/>
<br/>
A frame is a component. However, its use typically differs from most other components that appear on the Component palette. The following steps demonstrate how to use a frame: <br/>
<br/>
Select Form1 of the application you created in the preceding steps. <br/>
<br/>
Add two group boxes to the form, one above the other. Set the caption of the first frame to Customers, and the caption of the second to Employees. Your form may look something like that shown in Figure 2. <br/>
<br/>
Now add the frames. With the Standard page of the Component palette selected, click on the Frame component and drop it in the Customers frame. Delphi responds by displaying the Select frame to insert dialog box (see Figure 3). <br/>
<br/>
Select NameFrame. The frame will now appear in the Customers frame. Repeat this process, this time placing the frame within the Employees frame. You may have to select each frame and correct its size, depending on how you placed it originally. When you're done, your form should look similar to that shown in Figure 4. <br/>
<br/>
Continue by placing two Table components onto the form. Set the DatabaseName property of both tables to IBLocal. Set the TableName property of Table1 to CUSTOMER and the TableName property of Table2 to EMPLOYEE. Make both tables active by setting their Active properties to True. <br/>
<br/>
Here's where things get interesting. Select the DataSource in the Customers frame, and set its DataSet property to Table1. Normally you can't directly select objects that appear within a component, but frames are special. You can select any of the objects that appear within a frame, and work with their properties. Next, repeat this operation by selecting the DataSource in the Employees frame and setting its DataSet property to Table2. <br/>
<br/>
Finally, hook up all the DBEdits. Assign the DataField property of the three DBEdits on the Customers frame to CUST_NO, CONTACT_FIRST, and CONTACT_LAST, respectively. For the Employees frame, set the DataField properties of these same DBEdits to EMP_NO, FIRST_NAME, and LAST_NAME. <br/>
<br/>
Save this project and then run it. The running project will look something like that shown in Figure 5. <br/>
<br/>
<br/>
<br/>
Figure 2: A form ready for the placement of frames. <br/>
<br/>
<br/>
Figure 3: The Select frame to insert dialog box. <br/>
<br/>
<br/>
Figure 4: Two instances of NameFrame appear on this form. <br/>
<br/>
<br/>
Figure 5: The example frame project at run time. <br/>
<br/>
Frames and Inheritance<br/>
<br/>
Up to this point, there may seem to be little benefit to using frames. However, it's when you use the same frame in a number of different situations, and then want to change all instances, that the power of frames becomes obvious. For example, imagine you've decided to make NameFrame read-only. This can be accomplished easily by simply changing the original frame; each frame instance immediately inherits all changes. <br/>
<br/>
You can demonstrate this by following these steps: <br/>
<br/>
With the project created in the preceding section, press [Shift][F12] and select NameFrame from the displayed list of forms. <br/>
<br/>
Set the AutoEdit property of the DataSource to False. <br/>
<br/>
Next, select the DBNavigator, expand its VisibleButtons property, and set the nbInsert, nbDelete, nbEdit, nbPost, and nbCancel flags to False. <br/>
<br/>
Now look at your main form. Notice that both NameFrame descendants have inherited the changes you made to the frame (see Figure 6). <br/>
<br/>
<br/>
<br/>
Figure 6: Updating NameFrame automatically causes all instances to be updated as well. <br/>
<br/>
Overriding Contained Component Properties<br/>
<br/>
One of the advantages of frames (one shared with VFI) is that you can change the properties and event handlers associated with the objects inside the inherited frame. These changes override the inherited values. Specifically, subsequent changes to the overridden property in the original frame don't affect the inherited value. The following steps demonstrate this behavior: <br/>
<br/>
Select the label whose caption is "ID" in the Customers frame. Using the Object Inspector, change its Caption property to Customer No:. Now select the ID label for the Employees frame and change it to Employee ID:. <br/>
<br/>
Press [Shift][F12] and select NameFrame. Change the caption of this ID label to Identifier. <br/>
<br/>
Return to the main form. Notice that the Caption properties of the labels haven't changed to Identifier. They still use their overridden values. <br/>
<br/>
This effect is accomplished through information stored in the DFM file. Figure 7 displays a relevant part of the DFM file for this project. <br/>
<br/>
<br/>
<br/>
Figure 7: A DFM file containing property overrides for a frame instance. <br/>
<br/>
Notice that information about all components contained within the frame whose property values have been changed appear in the frame's inline section of the DFM file. However, this section only lists those values that have been changed. All other properties are assigned their values based either on the values set for the original frame (and which are stored in the frame's DFM file), or are designated as default values in the individual component's class declarations. <br/>
<br/>
Contained Object Event Handlers<br/>
<br/>
Objects contained within a frame may also have event handlers. Although events are simply properties of a method pointer type, they're treated differently than other types of properties when it comes to overriding the default behavior defined for the frame. <br/>
<br/>
Let's begin by considering how an event handler is defined for a frame object. Consider the frame shown in Figure 8. (This code is found in the Frame2 project found in the download for this article.) This frame contains two buttons, one labeled Help and the other Done. (Of course, these captions can be overridden in descendant frames). These buttons also have OnClick event handlers, which are shown in Figure 9. <br/>
<br/>
<br/>
Figure 8: A frame with components that have event handlers. <br/>
<br/>
procedure TTwoButtonFrame.Button1Click(Sender: TObject);<br/>
begin<br/>
if (TComponent(Sender).Tag = 0) or<br/>
(Application.HelpFile = '') then<br/>
MessageBox(Application.Handle, 'Help not available',<br/>
'Help', MB_OK)<br/>
else<br/>
Application.HelpContext(TComponent(Sender).Tag);<br/>
end;<br/>
<br/>
procedure TTwoButtonFrame.Button2Click(Sender: TObject);<br/>
var<br/>
AParent: TComponent;<br/>
begin<br/>
AParent := TComponent(Sender).GetParentComponent;<br/>
while not (AParent is TCustomForm) do<br/>
AParent := AParent.GetParentComponent;<br/>
TCustomForm(AParent).Close;<br/>
end;<br/>
Figure 9: The OnClick event handlers for the Help and Done buttons on our frame. <br/>
<br/>
Just as the event handlers for objects on a form are published methods of that form's class, the event handlers of objects on a frame are published methods of that frame. (The code segment doesn't actually depict the fact that these methods are published. Rather, they're declared in the default visibility section of the frame's class declaration, and the default visibility is published.) <br/>
<br/>
If you inspect the code associated with the Button2Click event handler, which is associated with the Done button, you'll notice that the event handlers associated with the frame introduces an interesting artifact. Specifically, Self is the frame, not the form in which the frame is contained. Consequently, it isn't possible to simply invoke the Close method from within this event handler to close the form. When an unqualified method invocation appears in code, the compiler assumes you want it to apply to Self. Because a TFrame object doesn't have a Close method, the compiler generates an error if you simply use an unqualified call to Close.<br/>
<br/>
Because the frame in this example is designed to be embedded within a form, the event handler uses the GetParentComponent method of the frame to climb the containership hierarchy within which the frame is nested. Once a TCustomForm instance is found (which will either be a TForm descendant or a custom form based upon TCustomForm), that reference is used to invoke the form's Close method. <br/>
<br/>
Overriding Contained Object Event Handlers<br/>
<br/>
If you're familiar with event overriding in VFI, you'll recall that Delphi embeds a call to inherited from within an overridden event handler on a descendant form. You can then alter the generated code to either add additional behavior before, or following, the call to inherited, or conditionally invoke inherited, or you can omit the call altogether. <br/>
<br/>
Frame descendants don't use inherited when invoking the event handler for an object embedded on the parent frame. Instead, the ancestor frame's method is called directly. For example, if you place the TwoButtonFrame frame (shown in Figure 8) onto a form and then double-click it, Delphi will generate the following code: <br/>
<br/>
procedure TForm1.TwoButtonFrame1Button2Click(<br/>
Sender: object);<br/>
begin<br/>
TwoButtonFrame1.Button2Click(Sender);<br/>
end;<br/>
<br/>
In this generated code, TwoButtonFrame1 is the frame descendant of TTwoButtonFrame (the original frame's class). Button2Click, as you saw in the earlier code segment, is the event handler for the Done button on that frame. As a result, this code invokes the original event handler, passing it the Sender that was passed to the button on the frame instance. <br/>
<br/>
This means that event handling introduces another interesting feature. Specifically, in these situations, Sender is generally not a member of the Self object. Indeed, Sender is usually a member of the form object, and Self is the frame object. <br/>
<br/>
Figure 10 shows an overridden event handler for a TwoButtonFrame descendant that was placed on a form. In this case, the original behavior is "commented out," so the new behavior completely replaces the originally defined behavior for the Done button. <br/>
<br/>
procedure TForm1.TwoButtonFrame1Button2Click(<br/>
Sender: TObject);<br/>
begin<br/>
with TForm2.Create(Self) do<br/>
begin<br/>
ShowModal;<br/>
Release;<br/>
end;<br/>
// The following is the original, auto-generated code<br/>
// TwoButtonFrame1.Button2Click(Sender);<br/>
end;<br/>
Figure 10: An overridden event handler for a TwoButtonFrame descendant that was placed on a form. <br/>
<br/>
The caption of this button was also overridden, so it displays the text, Start. Figure 11 shows the form on which this TwoButtonFrame descendant appears. <br/>
<br/>
<br/>
Figure 11: This TwoButtonFrame instance overrides both the caption and the OnClick event handler. <br/>
<br/>
Frames that Save Resources<br/>
<br/>
The form shown in Figure 11 actually contains two frames. We've already discussed the TwoButtonFrame frame. The second frame displays the company logo, and is named LogoFrame.<br/>
<br/>
LogoFrame appears on more than one form in the FramDemo project. The alternative to using a frame to display the logo is to place an Image object on each form upon which you want the logo to appear. However, the use of a frame for this purpose significantly reduces the amount of resources that must be compiled into the .EXE, and, therefore, results in a smaller executable. <br/>
<br/>
<br/>
The reason for this can be seen if you consider the following segment of the DFM file for the form shown in Figure 11: <br/>
<br/>
inline LogoFrame1: TLogoFrame<br/>
Left = 6<br/>
Top = 6<br/>
Width = 211<br/>
Height = 182<br/>
inherited Image1: TImage<br/>
Width = 211<br/>
Height = 182<br/>
end<br/>
end<br/>
<br/>
If, instead, a TImage instance had been placed onto the form, the DFM file for the form would have had to contain the entire binary representation of the logo. Figure 12 shows a segment of LogoFrame's DFM file. (Note that it shows only a tiny portion of the entire hexadecimal representation of the binary resource.) Furthermore, every form containing one of these images would have repeated this resource. When a frame is used, however, that resource is defined only once. <br/>
<br/>
object LogoFrame: TLogoFrame<br/>
Left = 0<br/>
Top = 0<br/>
Width = 239<br/>
Height = 178<br/>
TabOrder = 0<br/>
object Image1: TImage<br/>
Left = 0<br/>
Top = 0<br/>
Width = 239<br/>
Height = 178<br/>
Align = alClient<br/>
Picture.Data = {<br/>
07544269746D6170D6540000424DD654000000000000760000...<br/>
Figure 12: A segment of LogoFrame's DFM file. <br/>
<br/>
Simplifying Frame Use<br/>
<br/>
Within a single, small project, it's fairly easy to use the Frame component on the Standard page of the Component palette. For larger projects, however, or for situations where you want to use the same frame in multiple applications, you need something easier. Fortunately, Delphi permits you to place individual frames onto the Component palette, permitting these frames to be used easily and repeatedly without the extra steps required by the Frame component. A frame can also be placed into the Object Repository, permitting it to be copied easily. Both of these techniques are described in the following sections. <br/>
<br/>
Adding a Frame to the Component Palette<br/>
<br/>
By placing a particular frame onto the Component palette, you make its placement as simple as any other. By comparison, using the Frame component on the Standard page of the Component palette requires four steps and limits you to placing frames already defined within your project. To place a particular frame onto the Component palette, follow these steps: <br/>
<br/>
Save your frame to disk. If you want to use this frame in multiple applications, it's highly recommended that you save the frame to a directory that won't be deleted when you update Delphi. For example, create a folder named c:\Program Files\Borland\DelphiFrames and store your frames there. <br/>
<br/>
Select the frame and right-click on it. Select Add to Palette. Delphi displays the Component Template Information dialog box (see Figure 13). <br/>
<br/>
Define the name of the frame component in the Component name field, the page of the Component palette on which you want the frame to appear in the Palette page field, and, if you've created a custom 24 x 24 pixel, 16-color icon for the frame, click the Change button to select this .BMP file. Click OK when you're done. <br/>
<br/>
<br/>
<br/>
Figure 13: The Component Template Information dialog box. <br/>
<br/>
Using a Frame from the Component Palette<br/>
<br/>
To use a frame previously placed on the Component palette, select the page of the Component palette onto which you saved the frame, select the frame's icon, and drop it onto the form on which you want a descendant of that frame to appear. This process requires only two steps. <br/>
<br/>
Adding a Frame to the Object Repository<br/>
<br/>
By adding a frame to the Object Repository, you make it easy to copy it into a new project. Especially important is the ability to use the inheritance offered by the Object Repository to place an inherited frame into a new project, thereby maintaining the relationship between the frame and its ancestor. To add a frame to the Object Repository, follow these steps: <br/>
<br/>
Save your frame to disk. In addition to saving this frame to Delphi's OBJREPOS directory or to a shared directory, you can also save it to the same one to which you save frames that you add to the Component palette. Saving the frame to a shared directory is especially nice if you are using a shared object repository. This permits multiple developers to share frames. <br/>
<br/>
Right-click the frame and select Add To Repository. Delphi responds by displaying the Add To Repository dialog box (see Figure 14). <br/>
<br/>
Fill out the Add To Repository dialog box just as you would for any template you're adding to the Object Repository. Click OK when done. <br/>
<br/>
<br/>
<br/>
Figure 14: The Add To Repository dialog box. <br/>
<br/>
Using a Frame from the Object Repository<br/>
<br/>
To use a frame from the Object Repository, use the following steps: <br/>
<br/>
Select File | New. <br/>
<br/>
Select the page of the Object Repository to which you saved your frame template (see Figure 15). <br/>
<br/>
Select the icon for the frame; then select the Inherit radio button. <br/>
<br/>
Click OK to add an inherited version of the frame to your project. <br/>
<br/>
<br/>
<br/>
Figure 15: The location of your frame template. <br/>
<br/>
If you select the Copy radio button instead of the Inherit radio button, the newly added frame will be a copy of the original frame. This is useful when you want to create a new frame, but don't want to maintain a relationship between it and the original. <br/>
<br/>
Conclusion<br/>
<br/>
Does it make a difference whether you place a frame you want to reuse on the Component palette or the Object Repository? The answer is a strong "Yes!" In most cases, you'll want to place frames you use frequently onto the Component palette. When you place a frame from the Component palette, you're always placing an instance of the frame class. You can then easily change the properties and event handlers of this instance as described earlier in this article. By comparison, placing a frame from the Object Repository creates a new class, not an instance. This new class is either a copy of the original or a descendant, depending on which radio button you select in the Object Repository dialog box. If you want to use a frame in a project, it makes a great deal of sense to place an instance, rather than define a new class for your frame. For this purpose, saving the frame to the Component palette is the best approach. <br/>
<br/>
The one situation where you might want to use the Object Repository is when you're specifically creating hierarchies of frames, where each frame descendant introduces additional objects, methods, or event handlers. Here, the inheritance offered by the Object Repository makes it easier for you to create each new descendant. However, once you've defined the frame descendants you want to use regularly, I would again suggest that you add these to the Component palette to simplify their use.<br/>
<br/>
<br/>
Component Download: delphi_frames.zip
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-87112681468869888352011-06-13T15:00:00.001-07:002011-06-25T03:31:54.364-07:00How to draw buttons on the title bar of a TForm
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to draw buttons on the title bar of a TForm<br/>
<br/>
Answer:<br/>
<br/>
Solve 1:<br/>
<br/>
Place an icon-sized TImage on a form and add the following code:<br/>
<br/>
unit Unit1;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;<br/>
<br/>
type<br/>
TForm1 = class(TForm)<br/>
Image1: TImage;<br/>
procedure FormCreate(Sender: TObject);<br/>
private<br/>
{Private declarations}<br/>
TitleBarCanvas: TCanvas;<br/>
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;<br/>
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;<br/>
procedure DrawExtraStuff;<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/>
var<br/>
NonClientMetrics: TNonClientMetrics;<br/>
begin<br/>
TitleBarCanvas := TCanvas.Create;<br/>
TitleBarCanvas.Handle := GetWindowDC(Handle);<br/>
NonClientMetrics.cbSize := SizeOf(NonClientMetrics);<br/>
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);<br/>
TitleBarCanvas.Font.Handle := CreateFontIndirect(NonClientMetrics.lfCaptionFont);<br/>
TitleBarCanvas.Brush.Style := bsClear;<br/>
Caption := '';<br/>
end;<br/>
<br/>
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);<br/>
begin<br/>
inherited;<br/>
DrawExtraStuff;<br/>
end;<br/>
<br/>
procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);<br/>
begin<br/>
inherited;<br/>
if Msg.Active then<br/>
TitleBarCanvas.Font.Color := clCaptionText<br/>
else<br/>
TitleBarCanvas.Font.Color := clInactiveCaptionText;<br/>
DrawExtraStuff;<br/>
end;<br/>
<br/>
procedure TForm1.DrawExtraStuff;<br/>
var<br/>
X, Y, TransColor: Integer;<br/>
begin<br/>
{set the transparent color to bottom left pixel}<br/>
TransColor := Image1.Canvas.Pixels[0, Image1.Picture.Height - 1];<br/>
with Image1 do<br/>
for x := 0 to Picture.Width - 1 do<br/>
for y := 0 to Picture.Height - 1 do<br/>
if Canvas.Pixels[x, y] <> TransColor then<br/>
TitleBarCanvas.Pixels[22 + x, 5 + y] := Canvas.Pixels[x, y];<br/>
TitleBarCanvas.TextOut(40, 6, '<- Here is the other icon');<br/>
end;<br/>
<br/>
end.<br/>
<br/>
<br/>
Solve 2:<br/>
<br/>
I got my first clue 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 little 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 well-known Delphi/Pascal guru, Neil Rubenking, for help. He pointed me in the direction of his book, "Delphi Programming Problem Solver," which had an example of doing this exact thing. The code you'll see 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. Neil 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 that I'm continually discovering is that there is a very definitive structure in Windows - 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 that we are interested in here are not the usual Windows messages handled by 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 which is where most applications present information. The non-client area of a window consists of its 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 message type 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 that 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/>
We need to have a function to draw the button<br/>
We'll have to trap drawing and painting events so that our button stays visible when the form activates, resizes, or moves<br/>
Since we're dropping a button on the title bar, we have to have some way of trapping for a mouse click on the button.<br/>
<br/>
I'll now discuss these topics, in the above order.<br/>
<br/>
<br/>
Drawing a TRect as a Button<br/>
<br/>
As I mentioned above, you can't drop VCL objects onto a non-client area of a window, but you can draw on it and essentially 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/>
You have to 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. 2.Then, you have to define a TRect structure with the proper size and position within the title bar. 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 this is accomplished in a single call. For this program we make a call to a procedure called DrawTitleButton, 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/>
{$IFNDEF WIN32}<br/>
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,<br/>
XTtlBit + 2, YTtlBit + 2);<br/>
{$ELSE} {Delphi 2.0 positioning}<br/>
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br/>
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,<br/>
XTtlBit + 2, YTtlBit + 2)<br/>
else<br/>
TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,<br/>
YTtlBit + 2);<br/>
{$ENDIF}<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/>
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 which 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 what 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 it is, then 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. Again, you'll see that I used a conditional compiler directive to draw the bitmap under different versions of Windows. I did this purely for personal reasons because the bitmap that I used was 16 X 16 pixels in dimension, 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/>
<br/>
Trapping the Drawing and Painting Events<br/>
<br/>
You have to 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, but also redraw our button when they fire off. The following four procedures handle the paint triggering and painting events:<br/>
<br/>
{Paint triggering events}<br/>
<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/>
<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/>
<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 below:<br/>
<br/>
{Mouse-related procedures}<br/>
<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/>
<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. This was purely for simplicity's sake, but you can make any call you choose to at this point.<br/>
<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, Forms, Dialogs,<br/>
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);<br/>
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/>
<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/>
{$IFNDEF WIN32}<br/>
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,<br/>
XTtlBit + 2, YTtlBit + 2);<br/>
{$ELSE} {Delphi 2.0 positioning}<br/>
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then<br/>
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,<br/>
XTtlBit + 2, YTtlBit + 2)<br/>
else<br/>
TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,<br/>
YTtlBit + 2);<br/>
{$ENDIF}<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/>
finally<br/>
ReleaseDC(Self.Handle, Canvas.Handle);<br/>
bmap.Free;<br/>
Canvas.Handle := 0;<br/>
end;<br/>
end;<br/>
<br/>
{Paint triggering events}<br/>
<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/>
<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/>
<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/>
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 might also want to 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. Take heed though, playing around with Windows messages can be dangerous. Save your work constantly, and be prepared for some system crashes while you mess around with them.<br/>
<br/>
<br/>
Solve 3:<br/>
<br/>
unit TitleBtn;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Dialogs,<br/>
Buttons, Controls, StdCtrls, ExtCtrls;<br/>
<br/>
type<br/>
TTitleBtnForm = class(TForm)<br/>
procedure FormResize(Sender: TObject);<br/>
procedure FormCreate(Sender: TObject);<br/>
function GetSystemTitleBtnCount: integer;<br/>
procedure KillHint;<br/>
private<br/>
TitleButton: TRect;<br/>
FActive: boolean;<br/>
FHint: THintWindow;<br/>
Timer2: TTimer;<br/>
procedure DrawTitleButton(i: integer);<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-related messages}<br/>
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;<br/>
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);<br/>
message WM_NCLBUTTONDOWN;<br/>
procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message WM_NCLBUTTONUP;<br/>
procedure WMNCMouseMove(var Msg: TWMNCMouseMove); message WM_NCMouseMove;<br/>
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);<br/>
{-}<br/>
function GetVerInfo: DWORD;<br/>
{-}<br/>
procedure ShowHint;<br/>
procedure Timer2Timer(Sender: TObject);<br/>
public<br/>
end;<br/>
<br/>
const<br/>
htTitleBtn = htSizeLast + 1;<br/>
<br/>
implementation<br/>
<br/>
uses<br/>
PauLitaData, About, SpoolMessages;<br/>
<br/>
procedure TTitleBtnForm.FormResize(Sender: TObject);<br/>
begin<br/>
Perform(WM_NCACTIVATE, Word(Active), 0);<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.DrawTitleButton(i: integer);<br/>
var<br/>
bmap: TBitmap; {Bitmap to be drawn - 16x16: 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/>
n: 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/>
n := GetSystemTitleBtnCount;<br/>
if GetVerInfo = VER_PLATFORM_WIN32_NT then<br/>
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1 - 3, YFrame + 1 - 3,<br/>
XTtlBit - 2, YTtlBit - 4)<br/>
else<br/>
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1, YFrame + 1, XTtlBit<br/>
- 2, YTtlBit - 4);<br/>
Canvas.Handle := GetWindowDC(Self.Handle);<br/>
try<br/>
{Draw a button face on the TRect}<br/>
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, FALSE, FALSE, FALSE);<br/>
bmap := TBitmap.Create;<br/>
DataModule1.ImageList1.GetBitmap(i, bmap);<br/>
with TitleButton do<br/>
if GetVerInfo = VER_PLATFORM_WIN32_NT then<br/>
Canvas.Draw(Left + 2, Top + 2, bmap)<br/>
else<br/>
Canvas.StretchDraw(TitleButton, bmap);<br/>
finally<br/>
ReleaseDC(Self.Handle, Canvas.Handle);<br/>
bmap.Free;<br/>
Canvas.Handle := 0;<br/>
end;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);<br/>
begin<br/>
inherited;<br/>
DrawTitleButton(0);<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);<br/>
begin<br/>
inherited;<br/>
DrawTitleButton(0);<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);<br/>
begin<br/>
inherited;<br/>
DrawTitleButton(0);<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);<br/>
begin<br/>
inherited;<br/>
if (Msg.HitTest = htTitleBtn) then<br/>
DrawTitleButton(1);<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);<br/>
begin<br/>
inherited;<br/>
if (Msg.HitTest = htTitleBtn) then<br/>
begin<br/>
KillHint;<br/>
ShowAboutBox;<br/>
end;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCMouseMove(var Msg: TWMNCMouseMove);<br/>
begin<br/>
inherited;<br/>
if (Msg.HitTest = htTitleBtn) and PtinRect(TitleButton, Point(Msg.XCursor - Left,<br/>
Msg.YCursor - Top)) then<br/>
ShowHint<br/>
else<br/>
KillHint;<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/>
end;<br/>
<br/>
procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);<br/>
begin<br/>
inherited;<br/>
with Msg do<br/>
begin<br/>
if PtinRect(TitleButton, Point(XPos - Left, YPos - Top)) then<br/>
Result := htTitleBtn;<br/>
end;<br/>
end;<br/>
<br/>
function TTitleBtnForm.GetSystemTitleBtnCount: integer;<br/>
var<br/>
Menu: HMenu;<br/>
i, n, m, l: integer;<br/>
begin<br/>
l := 0;<br/>
Menu := GetSystemMenu(Handle, FALSE);<br/>
n := GetMenuItemCount(Menu);<br/>
for i := 0 to n - 1 do<br/>
begin<br/>
m := GetMenuItemID(Menu, i);<br/>
if (m = SC_RESTORE) or (m = SC_MAXIMIZE) or (m = SC_CLOSE) then<br/>
Inc(l)<br/>
else if (m = SC_MINIMIZE) then<br/>
Inc(l, 2);<br/>
end;<br/>
Result := l;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.KillHint;<br/>
begin<br/>
if Assigned(Timer2) then<br/>
begin<br/>
Timer2.Enabled := FALSE;<br/>
Timer2.Free;<br/>
Timer2 := nil;<br/>
end;<br/>
if Assigned(FHint) then<br/>
begin<br/>
FHint.ReleaseHandle;<br/>
FHint.Free;<br/>
FHint := nil;<br/>
end;<br/>
FActive := FALSE;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.Timer2Timer(Sender: TObject);<br/>
var<br/>
thePoint: TPoint;<br/>
theRect: TRect;<br/>
Count: DWORD;<br/>
i: integer;<br/>
begin<br/>
Timer2.Enabled := FALSE;<br/>
Timer2.Free;<br/>
Timer2 := nil;<br/>
thePoint.X := TitleButton.Left;<br/>
thePoint.Y := TitleButton.Bottom - 25;<br/>
with theRect do<br/>
begin<br/>
topLeft := ClientToScreen(thePoint);<br/>
Right := Left + Canvas.TextWidth(MsgAbout) + 10;<br/>
Bottom := Top + 14;<br/>
end;<br/>
FHint := THintWindow.Create(Self);<br/>
FHint.Color := clInfoBk;<br/>
FHint.ActivateHint(theRect, MsgAbout);<br/>
for i := 1 to 7 do<br/>
begin<br/>
Count := GetTickCount;<br/>
repeat<br/>
{Application.ProcessMessages;}<br/>
until<br/>
(GetTickCount - Count >= 18);<br/>
with theRect do<br/>
begin<br/>
Inc(Top);<br/>
Inc(Bottom);<br/>
FHint.SetBounds(Left, Top, FHint.Width, FHint.Height);<br/>
FHint.Update;<br/>
end;<br/>
end; { i }<br/>
FActive := TRUE;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.ShowHint;<br/>
begin<br/>
if FActive then<br/>
Exit;<br/>
if Assigned(Timer2) then<br/>
Exit;<br/>
Timer2 := TTimer.Create(Self);<br/>
Timer2.Interval := 500;<br/>
Timer2.OnTimer := Timer2Timer;<br/>
Timer2.Enabled := TRUE;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:<br/>
Integer);<br/>
begin<br/>
inherited;<br/>
KillHint;<br/>
end;<br/>
<br/>
procedure TTitleBtnForm.FormCreate(Sender: TObject);<br/>
begin<br/>
OnMouseMove := FormMouseMove;<br/>
end;<br/>
<br/>
end.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-48929194874348367752011-06-12T15:00:00.001-07:002011-06-25T03:31:56.793-07:00Dynamic Arrays
<br/>
Problem/Question/Abstract:<br/>
<br/>
Dynamic Arrays overview <br/>
<br/>
Answer:<br/>
<br/>
The Long and Winding Way of the Dynamic Array<br/>
<br/>
Dynamic arrays were introduced to Object Pascal in Delphi 4. It was, however, not the first attempt of the Pascal/Delphi team to evolve the static array of Wirth's original Pascal.<br/>
<br/>
Before going any further, let's first clarify some terminology. The terms "static" and "dynamic" are now applied at least four ways:<br/>
<br/>
For arrays whose boundaries may vary (dynamic), versus arrays with constant boundaries (static). <br/>
For the methods of assigning memory to the variables: Either their relative addresses are known at compile time (static), or the addresses are assigned by the system at run time (dynamic). Correspondingly, there are two methods of memory allocation: on the stack (static), or on the heap (dynamic). <br/>
There are two methods referring to variables: either directly by their names (static), with one-to-one correspondence between a variable and its instance in memory; or indirectly via pointers (dynamic) where a variable and its instance are not the same. <br/>
Methods in the class declaration may be either static or virtual/dynamic. <br/>
<br/>
This article follows the evolution of the "dynamic" concept with regard to arrays only. We will analyze its particularities for all array types appearing in Borland's Object Pascal. In addition to the standard arrays (static), there are now three more types in the family of arrays: open, variant, and dynamic. Why so many? Although it's beyond the scope of this article, we should also add to this list all the different types of strings in Delphi 4, which are a family of special character arrays whose diversity is even larger.<br/>
<br/>
The Origin<br/>
<br/>
The idea of dynamic arrays has a long history, beginning as early as ALGOL-60. In ALGOL-60, the syntax of array type looks similar to that of Pascal. For example, a declaration:<br/>
<br/>
Real array A[M1: N1, M2: N2, M3: N3]<br/>
<br/>
defines a 3D array of Real numbers. Only constants (integer numbers) are allowed as the array boundaries in the outermost block - just as in Pascal; in this case, the array is called static. But in the inner blocks of ALGOL-60, unlike Pascal, the boundaries may be variables (see Figure 1).<br/>
<br/>
begin<br/>
Real array A[1: 100, 0..10]; { Static array in ALGOL-60. }<br/>
Integer M1, N1, M2, N2; { Variables. }<br/>
{ M1, N1, M2, N2 have to be defined. }<br/>
...<br/>
begin<br/>
Real array B[M1: N1, M2: N2]; { Dynamic array in ALGOL-60. }<br/>
Real array C[1: 3, 1: 4]; { "Static" array in ALGOL-60. }<br/>
...<br/>
end;<br/>
...<br/>
end<br/>
Figure 1: Variable boundaries in the inner blocks of ALGOL-60.<br/>
<br/>
In the inner blocks, the array boundaries could be any arithmetic expression with the only requirement that numeric values were assigned to all variables in the boundaries before entering the block. Therefore, beginning with ALGOL-60, the concept of a dynamic array means that its boundaries may vary during run time, while for static arrays only explicit numbers are allowed in the boundary expressions.<br/>
<br/>
For arrays that are local variables (like arrays B and C in Figure 1), the memory was allocated when entering the block and released when leaving it. Because declarations of the variables local in a block could appear only in the beginning of that block, no complications with redefining dynamic arrays occurred, and obviously such arrays could not be kept till the next entrance in this block. Nevertheless, in ALGOL-60, one could use the specifier own for any local variable including dynamic arrays, which meant that, although the visibility of the concerned variables obeyed the rule of scope, their values were kept available after re-entering the block. According to the Revised Report on ALGOL-60, this persistency in case of dynamic arrays ought to be followed also for the subset of indexes that are valid for the current and previous versions of the own array, although specific compilers could limit or simplify that behavior.<br/>
<br/>
Note: Regarding compile-time versus run-time assignment of memory to the variables, it was typically run-time assignment in ALGOL-60 versus compile time in Pascal, although both use the stack.<br/>
<br/>
The Long and Winding Road<br/>
<br/>
In Wirth's Pascal, programmers could derive an unlimited number of new types from the basic types, but, for some reasons, the basic array type strictly required only constant boundaries and, therefore, was allowed to deal only with static arrays. Wirth's motivation probably was to have very fast and efficient one-pass compilers, for which all but indirect variables (i.e. except instances of pointer types) are compile-time variables providing the most efficient access. As a drawback, there was no way to overcome the static nature of the arrays, e.g. to develop procedures that deal with vectors, matrixes, and other structures of arbitrary sizes. We had to hard-code all array sizes as the maximum possible numeric values in the const section at least once.<br/>
<br/>
For one-dimensional arrays, with a constant low boundary Low1 and variable boundary High1, we could resort to a trick involving indirect variables (pointers):<br/>
<br/>
type<br/>
TMaxArray = array[Low1..MaxInteger] of AnyType;<br/>
PArray = ^TMaxArray;<br/>
<br/>
and later allocate memory to the instance of PArray according to the actual value of High1:<br/>
<br/>
GetMem(PArray, (High1 - Low1 + 1) * SizeOf(AnyType));<br/>
<br/>
Then, we can use index expressions like PArray^[k]; we can omit ^ because of the undocumented syntax feature of Delphi. Unfortunately, for multi-dimensional arrays, this approach with indirect variables doesn't work as simply with just one pointer. Another drawback is that we have to deal with pointers instead of direct variables (as we are responsible for allocating and de-allocating memory and other possible confusions connected with indirect access).<br/>
<br/>
Open Arrays<br/>
<br/>
The open array, introduced in Delphi 1, was the first extension of Pascal's concept of static arrays, but it wasn't really a type like the others that could be used to declare variables. Instead, it was an intrinsic type, applicable only to formal parameters in procedures and functions. If a formal parameter looks like this:<br/>
<br/>
FormalArr: array of TSomeType;<br/>
<br/>
then the actual parameter may be either a one-dimensional array of type TSomeType, just one variable, or the so-called open array constructor [Expr1, Expr2, ..., ExprN] - all of type TSomeType. The latter is a nice feature not available in ALGOL-60, otherwise the behavior of the open array as a formal parameter suffers two serious drawbacks. First, only one-dimensional arrays as actual parameters are allowed. Second, whatever the low and high boundaries of the actual array are, they're always mapped to the zero-based formal open array. The same is true for the open array constructor. The expressions are numbered starting with 0, which looks a little confusing. This zero-based indexing of the open arrays isn't consistent with the more convenient Pascal array boundaries of low..high type, but, for some reason, Borland still adheres to this principle.<br/>
<br/>
The open arrays enabled us to overcome a serious limitation of static arrays, and allowed us to deal comfortably with one-dimensional arrays. Thus, procedures for simple vectors of any size like scalar product, average, maximum, minimum, etc. were no longer a problem.<br/>
<br/>
The variant open array formal parameter looks like:<br/>
<br/>
FormalVarArr: array of const ;<br/>
<br/>
and is intended only to transfer the open array constructors containing expressions of different types as an actual parameter - an extension of the similar feature for open arrays and the predecessor of the more general idea of the type variant.<br/>
<br/>
Variant Arrays<br/>
<br/>
The Variant type, introduced by Delphi 2, was a very powerful extension of Pascal intended for different purposes. We're going to discuss it here only with regard to the concept of dynamic arrays. A variable declared as Variant may represent a multi-dimensional dynamic array, but you need a special non-Pascal statement to specify the dimensions and the type of elements:<br/>
<br/>
var<br/>
vArr: Variant;<br/>
{...}<br/>
begin<br/>
{...}<br/>
vArr := VarArrayCreate([Low1, High1, ..., LowN, HighN],<br/>
ElementType);<br/>
<br/>
where the boundaries may be variables and ElementType belongs to the fixed list of basic Pascal types denoted by the identifiers of the format varXXXX, for example varInteger, varDouble. After that we can consider vArr as an N-dimensional index variable vArr[i1,i2,...,iN]. This implementation is the closest to the notion of dynamic arrays as it appeared in ALGOL-60; it really made possible the multi-dimensional rectangular arrays with the variable boundaries of low..high type. Unfortunately, access to elements of variant arrays is at least 10 times slower than to static arrays; a simple benchmark that transposes a big matrix (e.g. A[i,j]:=A[j,i], i=1,...,N; j = 1,...,i-1) demonstrates it well. Also, in terms of memory consumption, any variant variable requires a 16-byte overhead. Although it doesn't seem too much if one variable represents a big array, it's something to keep in mind in case of many non-array variants. <br/>
<br/>
The re-dimensioning of variant arrays is possible within the same block, but only for the last (right-most) dimension; the special function, varArrayRedim, does the job.<br/>
<br/>
As to the efficiency of access to the elements, it may be improved to the level as fast as that of static arrays via the special procedure varArrayLock. It returns a pointer that is assignment compatible with pointers to any static array, but meaningful only if that static type corresponds exactly to the dimensions specified in the varArrayCreate. For example, for vArr, the corresponding static array type must be:<br/>
<br/>
TvArrStat = array[LoN..HiN, ..., Lo1..Hi1] of ElementType;<br/>
<br/>
with the dimensions specified in the order inverse to that in the varArrayCreate (why?!) and all LoN, HiN, ... Lo1, Hi1 being constants equal to the current values of the corresponding variable boundaries. Then, providing the declaration:<br/>
<br/>
var<br/>
vArrLock: ^TvArrStat;<br/>
<br/>
the statement:<br/>
<br/>
vArrLock := varArrayLock(vArr)<br/>
<br/>
allows us to use the index variable vArrLock^[iN,...,i1] (or simply vArrLock[iN,...,i1]) with the access speed as quick as static arrays. We increased speed, but, to deal with variable boundaries, we must explicitly declare as many different static array types as we are going to have in run time. For example, we may need to prepare in advance several type declarations:<br/>
<br/>
type<br/>
T200x200 = array[1..200; 1..200] of Real;<br/>
T150x150 = array[1..150; 1..150] of Real;<br/>
{...}<br/>
<br/>
and then specify the variable dimensions in the varArrayCreate according to one of these types - not a very convenient technique.<br/>
<br/>
The interesting feature of variant arrays is that the ElementType may be variant, too:<br/>
<br/>
vArr := VarArrayCreate([Low1, High1, varVariant)<br/>
<br/>
In particular, it means that individual elements vArr[k] may be defined as a variant array again with any number of dimensions of any size:<br/>
<br/>
vArr[k] := VarArrayCreate([kLow, kHigh, varDouble)<br/>
<br/>
This creates an illusion as though we can treat vArr as a two-dimensional, non-rectangular array. (The examples of non-rectangular arrays of two dimensions are triangle matrixes, or matrixes with just a few stripes. For three dimensions, it may be an integer grid of points inside a pyramid.) Unfortunately, the variant array of variant arrays doesn't work like the similar construction of the standard Pascal arrays. Providing the declaration of vArr given previously, the code compiles for the index variable like vArr[i,j], but stops with a run-time error (because vArr is created as one-dimensional). Surprisingly, vArr[i][j] - that should be the synonym in Pascal - shows different behavior: It even produces a syntax error if it appears in the left side of the assignment statement; a := vArr[i][j] compiles and runs correctly, while vArr[i][j] := b doesn't, resulting in a syntax error.<br/>
<br/>
So we see that although the variant array type allows some functionality of the ALGOL-60's dynamic arrays, the variant arrays are far more complex, slow, and not consistent with the Pascal's concept of arrays both in syntax and semantics.<br/>
<br/>
Dynamic Arrays of Delphi 4<br/>
<br/>
Finally, here is the latest attempt to implement the dynamic arrays (covered only on two pages of the Object Pascal Language Guide!). The declaration of one-dimensional dynamic arrays looks like this:<br/>
<br/>
type<br/>
TDynArray1 = array of baseType;<br/>
<br/>
boundaries [...] must be omitted, where the baseType may be also a static array type or a dynamic array type again. This allows the declaration of the multi-dimensional "mixture" as well as "purely" dynamic arrays. For example, the declaration for three dimensions takes the following form:<br/>
<br/>
type<br/>
TDynArray3 = array of array of array of baseType;<br/>
<br/>
This syntax allows us to declare a certain number of dimensions, but not their sizes (which require special consideration). Thus, if the baseType is of the non-array type, a variable:<br/>
<br/>
var<br/>
A, B: TDynArray3<br/>
<br/>
may be used with up to three indexes, e.g. A[i,j,k]. Otherwise, if the baseType = array[1..100;1..200] of Double, this variable may appear with up to five indexes A[k1,k2,k3,k4,k5].<br/>
<br/>
After a dynamic array variable is declared, it still cannot be used unless the special statement SetLength specifies the sizes of all dimensions and allocates the required memory. This shows the important difference between the static and dynamic arrays. The latter are - but only partially behave like - hidden pointers, i.e. a dynamic array variable is not strictly associated with its memory image, the instance, but rather separates from it.<br/>
<br/>
Thus, the above-mentioned variable A (without indexes), or A[i], or A[i,j] (with number of indexes less than the declared number) are all hidden pointers. As such, at certain moments they may point nowhere, or more than one hidden pointer may point to the same instance. For example, after the assignment A := B, both A and B point to the same instance of B, so that any change to the elements of A affects B; this contradicts the usual meaning of the assignment statement. While the instance of A (if it exists) seems to be lost because it's pointed to by nothing, it doesn't cause a memory leak, which is prevented by the so-called reference count technique implemented for the dynamic arrays. For that reason, two consecutive statements - SetLength(A, ...) and SetLength(A, ...) - don't cause the loss of the piece of memory allocated in the first statement (leak) - unlike the similar situation, say, for classes. The sequence: <br/>
<br/>
X := TAnyClass.Create;<br/>
X := TAnyClass.Create;<br/>
<br/>
is a mistake. Also, the assignment:<br/>
<br/>
A := nil<br/>
<br/>
actually signals to the system that the memory (instance) must be freed, which is never the case for classes or pointers.<br/>
<br/>
And even if:<br/>
<br/>
A[i1, i2, i3] = B[i1, i2, i3]<br/>
<br/>
for all indexes, it never means that the conditions:<br/>
<br/>
A = B or A[i1] = B[i1] or A[i1, i2] = B[i1, i2]<br/>
<br/>
are True, because these partially-indexed variables point to different locations.<br/>
<br/>
In terms of persistency, while leaving and re-entering a block, the dynamic array variables behave like all other local (static) variables: leaving the block, the variables and their instances are freed automatically. For local variables of the types class and pointer it's wrong to leave the block without freeing all the instances of all such variables - the reason why such variables must be declared, for example, global. The user should nil a dynamic array only if it's important to free the memory before leaving the block. Hence, dynamic arrays are much safer than classes and pointers.<br/>
<br/>
Thus, both the syntax and semantics of dynamic arrays differ from those of static arrays. Two system procedures, SetLength and Copy, previously intended to deal with strings, are applied now also for dynamic arrays. To define the sizes of dimensions - and the allowed index space - we must use the system procedure SetLength(A, Length1,...) with a non-fixed number of the integer parameters Length1,..., LengthN. At least one of them is always required to specify the size of the left-most dimension. If the number of dimensions is more than 1, the remaining sizes may be specified either in the same SetLength statement, or later in other such statements individually for each sub-array element. The former method defines rectangular arrays, similar to those known in ALGOL-60 or standard Pascal (but with mandatory zero low indexes), while the latter enables the so-called non-rectangular arrays.<br/>
<br/>
For example, providing:<br/>
<br/>
var<br/>
A: TDynArray3<br/>
<br/>
the single statement:<br/>
<br/>
SetLength(A, N1, N2, N3)<br/>
<br/>
defines the rectangular array with the index field [0..N1-1; 0..N2-1; 0..N3-1], while the statement:<br/>
<br/>
SetLength(A, N1)<br/>
<br/>
defines the size for the first dimension as N1 and correspondingly the index field for the first index as [0.. N1-1]. This postpones the definition of the 2 other dimensions for each A[k] individually. Figure 2 defines two types of triangle matrixes.<br/>
<br/>
var<br/>
A, B: array of array of Double;<br/>
N, i: Integer;<br/>
begin<br/>
{ Defining N. }<br/>
SetLength(A, N);<br/>
SetLength(B, N);<br/>
for i := 0 to N - 1 do<br/>
begin<br/>
{ Lower-left triangle matrix; index field 0<=i<=N-1, 0<=j<=i }<br/>
SetLength(A[i], i + 1);<br/>
{ Upper-left triangle matrix; index field 0<=i<=N-1, 0<=j<=N-i-1 }<br/>
SetLength(B[i], N - i);<br/>
end;<br/>
{ ...}<br/>
end;<br/>
Figure 2: Two types of triangle matrixes.<br/>
<br/>
Unfortunately, because of the limitation imposed by zero-based indexing, dynamic arrays don't allow us to define the lower- and upper-right triangle matrixes, matrixes with several diagonal stripes this way. Figure 3 shows some examples of three-dimensional dynamic arrays of a 3- and 4-lateral pyramid-type.<br/>
<br/>
var<br/>
C, D: array of array of array of Double;<br/>
N, i, j: Integer;<br/>
begin<br/>
{ Defining N }<br/>
SetLength(C, N);<br/>
SetLength(D, N);<br/>
for i := 0 to N - 1 do<br/>
begin<br/>
{ 4-lateral pyramid; index field 0<=i<=N-1, 0<=j,k<=i }<br/>
SetLength(C[i], i + 1, i + 1);<br/>
{ 3-lateral pyramid }<br/>
SetLength(D[i], i + 1);<br/>
for j := 0 to i do<br/>
{ index field 0<=i<=N-1, 0<=j<=i, 0<=k <=j }<br/>
SetLength(D[i, j], j + 1)<br/>
end;<br/>
{...}<br/>
end;<br/>
Figure 3: 3D dynamic arrays of a 3- and 4-lateral pyramid type.<br/>
<br/>
As to the speed of access to elements of dynamic arrays, it's almost as high as for static arrays, at least one- and two-dimensional ones, as the benchmark with matrix transposing proves. For static arrays, the memory location of each element in a multi-dimensional array is known as soon as the index expression computes. Thus, for a static element, such as A[k1,k2,k3], the relative location may look like this:<br/>
<br/>
N2N3 * k1 + N3 * k2 + k3<br/>
<br/>
Instead, for dynamic arrays to access an element of K-dimensional array, the code must sequentially de-reference K pointers to the respective one-dimensional sub-arrays. Both approaches seem compatible.<br/>
<br/>
Language Barrier<br/>
<br/>
The evolution of dynamic arrays in Borland Pascal/Delphi wasn't straightforward. With regard to the functionality, the multi-dimensional rectangular variant arrays are the closest to the concept of dynamic arrays as they first appeared in ALGOL-60, but variant arrays are 10 times slower than static ones, and they differ in syntax. In addition, for the concept of a variant array of variant arrays, both syntax and semantics remain not quite clear.<br/>
<br/>
The dynamic arrays in Delphi 4 exceed the arrays of ALGOL-60, at least in that they can be non-rectangular and still be as fast as static arrays in Pascal. Unfortunately, this notion reveals several language inconsistencies:<br/>
<br/>
Why the mandatory zero-based indexing when the static and variant arrays don't require it? The low..high indexing in standard Pascal is an important feature, and can be very helpful in many applications. Also, the most natural and safe method of numbering in structures like vectors and matrixes is to number the elements in a vector corresponding to the index field: 1..N, not 0..N-1. <br/>
Why the special syntax in the declaration that omits the boundaries [ ]? As a result, the separate statement, SetLength, is later always required. True, SetLength allows to re-define the dimensions several times within a block, if it's really needed, but for the more typical case when the dimensions and the sizes are declared once at the beginning of the block, the standard form array[low..high] is better, because it is consistent with the syntax. The compiler knows by itself if the boundary expression is constant or variable, therefore it could implement the static or dynamic models according to the situation. <br/>
The assignment statements with incomplete indexes for dynamic array variables such as A := B have a quite unusual meaning: Any change in an element A[k] affects also B[k] because A and B refer to the same instance. This behavior contradicts the standard meaning of the assignment statement and is dangerous, so that incomplete indexes in assignment statements for dynamic arrays shouldn't be allowed. <br/>
The behavior of dynamic arrays as hidden pointers is better and safer than the behavior of classes (also hidden pointers) or pointers. Why not improve the behavior of classes and pointers to the level of dynamic arrays so that all indirect reference mechanisms in the language follow uniform rules? <br/>
Logically, the Delphi type class must be simply an indirect reference version of the type object introduced in Turbo-Pascal 5.5. The only difference should be in the method of memory allocation: for the class on the heap, and for the object on the stack. This is safer and doesn't involve the dangerous separation of variables from their instances. Delphi 4 and all previous versions support the type object for backward compatibility, but there are still certain differences between syntax and semantics of both types. <br/>
<br/>
Conclusion<br/>
<br/>
The fact that now there are as many as four different array types with quite different and inconsistent syntax and semantics in Borland Pascal/Delphi doesn't seem to be a good thing. Too many - and not always good - new features have been added to standard Pascal, which makes it cluttered, hectic, and less safe. It looks like the language doesn't evolve according to a well-developed fundamental plan; rather, it's trying to cope somehow with all different and inconsistent features of the very complex operating environment.<br/>
<br/>
Delphi is still an unparalleled software development tool, but it's getting more and more complex, while its documentation and Help system lag behind. Even the Object Pascal Language Guide, the fundamental document of the language, is neither complete nor clear, or strict and formal enough as one should expect from a document of this type. This bears no resemblance to that high standard of documentation that Borland was proud of in the era of Borland Turbo Pascal. Back to the future?<br/>
<br/>
I am very thankful to Dr Manfred Mackeben for his patience in reading and improving this text and for many valuable notes.<br/>
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-90658152791627755502011-06-11T15:00:00.001-07:002011-06-25T03:31:58.681-07:00Internet Explorer Automation
<br/>
Problem/Question/Abstract:<br/>
<br/>
Internet explorer comes with windows, so is available on nearly every client machine of your users. It's many capabilities can be used from your delphi application. This article contains an introduction to this subject.<br/>
<br/>
Answer:<br/>
<br/>
Microsoft sells its windows product with its browser Internet Explorer. This browser, like all MS products, is COM based, so through its interface we can use this component. The component holds all core functionality of the browser, so this functionality is available from Delphi as well. Even better, the explorer can be put into edit mode, so you can use it to edit html pages as well.<br/>
<br/>
Usage of Internet Explorer in your application may enhance its functionality by a considerable degree. Recently I encountered the wish to use IE automation on two separate occasions. The first occasion was at the office, where an email application needed to be enhanced with html display as an increasing amount of mails had no plain text, just html. The second occasion was when some of the senior members of our church had difficulty maintaining the church website: used to just using MS word, and never even having bothered with things like directories, learning download with ftp, editing html, and uploading again just was too much to master in a short time. An integrated ftp / html-editing program seemed like the ideal solution. <br/>
<br/>
Development environment.<br/>
<br/>
The first thing we will have to do is install our development environment. This article is written with Delphi 5 enterprise, and tested with Delphi 7 personal edition.<br/>
<br/>
Start Delphi, select "Component - Import ActiveX Control". In the list, select "Microsoft Internet Controls (version 1.1)" and add it to a new or existing package. Delphi will generate a ShDocVw_TLB.pas file. In some instances, the file will be called ShDocVw.pas, for reasosn which are not entirely clear. Use Windows explorer to locate this file on your hard disk. Installing this component will also add the WebBrowser component to the component palette's Internet tab. (Some friends reported it on their ActiveX tab). If you don't have the 'Microsoft Internet controls' in your list of active X controls, import it from ShDocVw.dll.<br/>
<br/>
Another thing you will need is the mshtml type library. Search your pc for files named mshtml.pas or mshtml_tbl.pas. If you don't have them, import the type library (Project - Import type library - Microsoft html object library). If you don't see this one, search your pc for mshtml.tlb, and add this file to your project. If you can not find it - and Delphi 5 Enterprise edition seems to come with the IE component already installed, go again to "Component - Import ActiveX Control", select "Microsoft Html Object Library" and click 'create unit'. This type library is fairly large so its generation may take a while if you have an old CPU. <br/>
<br/>
Loading a page<br/>
<br/>
The first thing you will probably do is load an html page. Nothing is simpler than that. Create a new application, go to the Internet tab of your component palette. Create a button, and in the on click event create the code:<br/>
<br/>
WebBrowser1.Navigate('c:\webdemo\demo1.html');<br/>
<br/>
Now create this demo1.html with something like:<br/>
<br/>
hi<br/>
<br/>
<br/>
Just to show it supports more than plain text, create a page demo2 like:<br/>
<br/>
hi<br/>
<br/>
Underlinedbolditalic<br/>
<br/>
This is truly MS internet explorer. So you can not just load a page from your hard disk, you can also load a page from the web. As an illustration, drop a TEdit component on the form and name it 'edtWebAddress'. Create a econd button, label it 'Load web page', and in the onclick event enter: <br/>
<br/>
WebBrowser1.Navigate(edtWebAddress.text);<br/>
<br/>
Run your app, and enter 'www.google.com' in the edit field. You will notice that you don't need to enter the http: before the url, inserting this before the name is part of the behaviour of the component, not of the shell app you know as Internet Explorer. All pages will be loaded and displayed as pages would be in Internet Explorer itself. This includes forms and javascript.<br/>
<br/>
Navigating to a page is just one way of loading a page. You can also load it from stream. Add a new button to your form, label it 'Load from stream', and add:<br/>
<br/>
var<br/>
ms: TMemoryStream;<br/>
begin<br/>
ms := TMemoryStream.Create;<br/>
Tekst.SaveToStream(ms);<br/>
ms.seek(0, 0);<br/>
if WebBrowser1.Document <> nil then<br/>
Result := (WebBrowser1.Document as<br/>
IPersistStreamInit).Load(TStreamAdapter.Create(ms));<br/>
ms.free;<br/>
end;<br/>
<br/>
You will have to add the ActiveX file to your uses clause for the IPersistStreamInit declaration. The first time you start your app, no document will have been loaded. So Webbrowser1.document will be nil. Load a page or site page first, then run this code. This is exactly the reason for the if statement. There is a slight problem: under some circumstances (especially when you load a double byte coded page), loading from stream will show the html source instead of the intended layout. So generally you will want to navigate to a page instead.<br/>
<br/>
Before we leave the Navigate2 command, lets allow ourselves a small digression. You may have heard that Microsoft integrated Internet Explorer and Windows explorer. Try for yourself the next command:<br/>
<br/>
WebBrowser1.Navigate('c:\temp\');<br/>
<br/>
Forward and back<br/>
<br/>
IE, like every browser, has buttons for moving forward and back through the list of visited pages. The commands for these actions are so simple, that we hardly need to comment on them:<br/>
<br/>
begin<br/>
<br/>
WebBrowser1.Back;<br/>
<br/>
WebBrowser1.Forward;<br/>
<br/>
end; <br/>
<br/>
IE keeps track of the pages you have visited, you don't have to keep track of them yourself.<br/>
<br/>
Printing a page<br/>
<br/>
To print a page, once it has loaded, we can send a message OLECMDID_PRINT to the control interface. Add another button, declare two variables of type olevariant, and type the following code:<br/>
<br/>
var<br/>
vaIn, vaOut: OleVariant;<br/>
begin<br/>
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,<br/>
vaIn, vaOut);<br/>
end;<br/>
<br/>
Note that a document needs to have been loaded, else an access violation will occur.<br/>
<br/>
Discovering busy<br/>
<br/>
Some actions like loading a webpage or printing might take a while. Using the interface, you can see the moving graphics in the upper right corner as an indication that the browser is still busy. But how do you find if it's still busy in your program? The answer is provided by the ReadyState property. Add a label to your form, and add the following code to one of the previous buttons. <br/>
<br/>
while (WebBrowser1.ReadyState <> ReadyState_Complete) do<br/>
<br/>
begin<br/>
<br/>
Label1.caption := 'busy ..';<br/>
<br/>
Application.ProcessMessages;<br/>
<br/>
end;<br/>
<br/>
Label1.Caption := 'Ready';<br/>
<br/>
Retrieving and setting the html code<br/>
<br/>
Once we have loaded an html page, we might want to inspect the html code. One purpose might be to save it to file. Another purpose is if we want to build a dedicated html editor. The html resides in the IHtmldocuments, which is derived from IDispatch. We have to define a variable of the type IHTMLDocument2. This one is defined in the type library mentioned in the development environment paragraph above, and you have to include it in your uses clause.<br/>
<br/>
var<br/>
Doc: IHTMLDocument2;<br/>
Html: string;<br/>
begin<br/>
Doc := WebBrowser1.Document as IHTMLDocument2;<br/>
Html := Doc.body.InnerHTML;<br/>
ShowMessage('Innerhtml =' + Html);<br/>
Html := Doc.body.OuterHTML;<br/>
ShowMessage('Outerhtml =' + Html);<br/>
end;<br/>
<br/>
The InnerHtml property can also be used to set the contents of the page. Simply assign a new value to the Doc.Body.InnerHtml.<br/>
<br/>
Another action you might be interested in is the retrieval of text selected by the user.<br/>
<br/>
Clipboard activation<br/>
<br/>
To use Ctrl-C and Ctrl-v, we need to use initialize and un-initialize Olehandling. Windows provides two apis, which we can call in the intialization and finalization sections:<br/>
<br/>
initialization<br/>
<br/>
OleInitialize(nil);<br/>
<br/>
finalization<br/>
<br/>
OleUninitialize;<br/>
<br/>
Note that you will need to include the ActiveX unit in your uses clause.<br/>
<br/>
Retrieving Head section<br/>
<br/>
You may have noticed that when we retrieved the InnerHtml property, we did not get everything. All lines from the head section were missing. This also applied to the OuterHtml property, though according to many sources this property contains all the html. One way to obtain them would be to write the document to a file and read the file. But there is a faster and more direct way. <br/>
<br/>
The document has a property all of the type IHtmlCollection. This property contains all the html elements, and we can simply loop through the collection.<br/>
<br/>
var<br/>
Doc: IHTMLDocument2;<br/>
EllColl: IHTMLElementCollection;<br/>
i: integer;<br/>
Item: OleVariant;<br/>
begin<br/>
Doc := WebBrowser1.Document as IHTMLDocument2;<br/>
EllColl := Doc.all;<br/>
for i := 0 to EllCOll.Length - 1 do<br/>
begin<br/>
Item := EllColl.item(i, varEmpty);<br/>
ShowMessage(Item.tagname + '*contains*' + Item.InnerHtml);<br/>
end;<br/>
end; <br/>
<br/>
The elements in this collection can also be manipulated. You could, for instance, loop through the collection, check for a certain type, and then replace the contents.<br/>
<br/>
Editing<br/>
<br/>
The previous paragraph introduced us to some possibilities to replace part or all of the html code with new content. But you may not always be interested in changing everything by hand. It may be more interested in letting your user do the job. The good news is that your users will be able to change content directly, without your interference. Simple set the design property of the document:<br/>
<br/>
var<br/>
Doc: IHTMLDocument2;<br/>
begin<br/>
Doc := WebBrowser1.Document as IHTMLDocument2;<br/>
Doc.designMode := 'On';<br/>
end; <br/>
<br/>
Another way to achieve the same result:<br/>
<br/>
var<br/>
Doc: IHTMLDocument2;<br/>
begin<br/>
Doc := WebBrowser1.Document as IHTMLDocument2;<br/>
Doc.body.setAttribute('contentEditable', 'true', 0);<br/>
end; <br/>
<br/>
After setting this property, your user will be able to edit the contents of the file directly. The user is even able to apply formats by pressing ctrl-b, ctrl-i and ctrl-u. So in effect, you have much of the functionality of MS Frontpage at your disposal. Of course you will have to write your own interface around it for loading and saving files.<br/>
<br/>
Let's have a look at some of the stuff you might wish to use when writing your own html-editor.<br/>
<br/>
We already remarked that your user can use ctrl-b to make the selected text bold, italic or underlined:. A nice feature, but you will probably want to provide your user with a menu option and a speedbutton to provide the same functionality. The Document2 interface provides an 'execCommand' method, which enables us to do just that:<br/>
<br/>
var<br/>
Doc: IHTMLDocument2;<br/>
begin<br/>
Doc := WebBrowser1.Document as IHTMLDocument2;<br/>
Doc.execCommand('Underline', False, 0);<br/>
end; <br/>
<br/>
The second parameter, False in the above example, will prompt IE to present the user with a dialog if one is applicable (with the noticable exception of the saveAs command, which will always show a dialog!). The third parameter is an optional variant. It's possible values depend on the selected command.<br/>
<br/>
Here is a list of supported commands:<br/>
<br/>
2D-Position: Allows absolutely positioned elements to be moved by dragging.<br/>
<br/>
AbsolutePosition : Sets an element's position property to "absolute."<br/>
<br/>
BackColor : Sets or retrieves the background color of the current selection.<br/>
<br/>
Bold : Toggles the current selection between bold and nonbold.<br/>
<br/>
ClearAuthenticationCache : Clears all authentication credentials from the cache. <br/>
<br/>
Copy : Copies the current selection to the clipboard.<br/>
<br/>
CreateBookmark : Creates a bookmark anchor or retrieves the name of a bookmark anchor for the current selection or insertion point.<br/>
<br/>
CreateLink : Inserts a hyperlink on the current selection, or displays a dialog box enabling the user to specify a URL to insert as a hyperlink on the current selection.<br/>
<br/>
Cut : Copies the current selection to the clipboard and then deletes it. <br/>
<br/>
Delete : Deletes the current selection. <br/>
<br/>
FontName : Sets or retrieves the font for the current selection.<br/>
<br/>
FontSize : ets or retrieves the font size for the current selection.<br/>
<br/>
ForeColor : Sets or retrieves the foreground (text) color of the current selection.<br/>
<br/>
FormatBlock : Sets the current block format tag.<br/>
<br/>
Indent : Increases the indent of the selected text by one indentation increment.<br/>
<br/>
InsertButton : Overwrites a button control on the text selection.<br/>
<br/>
InsertFieldset : Overwrites a box on the text selection.<br/>
<br/>
InsertHorizontalRule : Overwrites a horizontal line on the text selection.<br/>
<br/>
InsertIFrame : Overwrites an inline frame on the text selection.<br/>
<br/>
InsertImage : Overwrites an image on the text selection.<br/>
<br/>
InsertInputButton : Overwrites a button control on the text selection.<br/>
<br/>
InsertInputCheckbox : Overwrites a check box control on the text selection.<br/>
<br/>
InsertInputFileUpload : Overwrites a file upload control on the text selection.<br/>
<br/>
InsertInputHidden : Inserts a hidden control on the text selection.<br/>
<br/>
InsertInputImage : Overwrites an image control on the text selection.<br/>
<br/>
InsertInputPassword : Overwrites a password control on the text selection.<br/>
<br/>
InsertInputRadio : Overwrites a radio control on the text selection.<br/>
<br/>
InsertInputReset : Overwrites a reset control on the text selection.<br/>
<br/>
InsertInputSubmit : Overwrites a submit control on the text selection.<br/>
<br/>
InsertInputText : Overwrites a text control on the text selection.<br/>
<br/>
InsertMarquee : Overwrites an empty marquee on the text selection.<br/>
<br/>
InsertOrderedList : Toggles the text selection between an ordered list and a normal format block.<br/>
<br/>
InsertParagraph : Overwrites a line break on the text selection.<br/>
<br/>
InsertSelectDropdown : Overwrites a drop-down selection control on the text selection.<br/>
<br/>
InsertSelectListbox : Overwrites a list box selection control on the text selection.<br/>
<br/>
InsertTextArea : Overwrites a multiline text input control on the text selection.<br/>
<br/>
InsertUnorderedList : Toggles the text selection between an ordered list and a normal format block.<br/>
<br/>
Italic : Toggles the current selection between italic and nonitalic.<br/>
<br/>
JustifyCenter : Centers the format block in which the current selection is located.<br/>
<br/>
JustifyLeft : Left-justifies the format block in which the current selection is located.<br/>
<br/>
JustifyRight : Right-justifies the format block in which the current selection is located.<br/>
<br/>
LiveResize : Causes the MSHTML Editor to update an element's appearance continuously during a resizing or moving operation, rather than updating only at the completion of the move or resize.<br/>
<br/>
MultipleSelection : Allows for the selection of more than one element at a time when the user holds down the SHIFT or CTRL keys.<br/>
<br/>
Outdent : Decreases by one increment the indentation of the format block in which the current selection is located.<br/>
<br/>
OverWrite : Toggles the text-entry mode between insert and overwrite.<br/>
<br/>
Paste : Overwrites the contents of the clipboard on the current selection.<br/>
<br/>
Print : Opens the print dialog box so the user can print the current page.<br/>
<br/>
Refresh : Refreshes the current document.<br/>
<br/>
RemoveFormat : Removes the formatting tags from the current selection.<br/>
<br/>
SaveAs : Saves the current Web page to a file.<br/>
<br/>
SelectAll : Selects the entire document.<br/>
<br/>
UnBookmark : Removes any bookmark from the current selection.<br/>
<br/>
Underline : Toggles the current selection between underlined and not underlined.<br/>
<br/>
Unlink : Removes any hyperlink from the current selection.<br/>
<br/>
Unselect : Clears the current selection.<br/>
<br/>
The Document2 interface not only provides us with a method execCommand to change the document, but also with the queryCommandState method which can tell us in what state the document is. <br/>
<br/>
if Doc.queryCommandState('JustifyLeft') then<br/>
ShowMessage('left');<br/>
<br/>
will tell us of the text is left justified. Note that this function only results in true if the text has been justified left explicitly, if it has been justified left by default the result is false.<br/>
<br/>
Every command has its own pecularities. This article would become too long to list them all, and most of them you will easily discover yourself.<br/>
<br/>
Sources<br/>
<br/>
Here are some sources for further study:<br/>
<br/>
http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/editing/editdesignerovw.asp#Tutorials<br/>
<br/>
tells a lot about the way Microsoft designed the built in editor of IE. Note that Microsoft has the habit of a-periodically but frequently redesigning their msdn site. So the link may have moved by the time you read this. <br/>
<br/>
http://bdn.borland.com/article/0,1410,26574,00.html <br/>
<br/>
Borland introduction to Internet Explorer automation <br/>
<br/>
http://groups.yahoo.com/group/delphi-webbrowser/ <br/>
<br/>
is a newsgroup with lots of info. <br/>
<br/>
Delphi 5 Enterprise edition comes with a small demo program. You can find it in the Demoes\Coolstuf directory.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-71367009142946997382011-06-10T15:00:00.001-07:002011-06-25T03:31:59.822-07:00Delphi/MSWord Automation FAQ
Problem/Question/Abstract:<br/>
<br/>
This document provides answers to some basic OLE Automation questions regarding Delphi (3 or 4) and Microsoft Word (8.0). The concepts outlined here can also be applied to many other MS applications (Excel, Internet Explorer etc) as well as any other application that supports OLE Automation.<br/>
<br/>
Answer:<br/>
<br/>
Setting up Delphi to work with Word<br/>
<br/>
In order for Delphi to access methods and properties exposed by Word (using OLE Automation early binding) the Word type library must be installed. Type libraries provide the definitions for all exposed methods and properties of an Automation Server in a standardized format that can be used by any compliant programming application including Delphi. To use Word's type library in Delphi select the "Import Type Library" from the "Project" menu and choose the file msword8.olb located in Microsoft Office's "Office" directory. This will create the file "Word_TLB.pas" which is the object pascal translation of the type library. The files Office_TLB.pas and VBIDE_TLB.pas will also be created since the Word type library references these type libraries. These files should be saved in Delphi's "Imports" directory. Now simply include Word_TLB in the uses list of any unit that will be accessing Word properties or methods.<br/>
<br/>
Finding help on Word's interfaces and methods<br/>
<br/>
All exposed functionality for Office applications is documented in the vba*.hlp files located in Microsoft Office's "Office" directory. For help on Word objects refer to the help file vbawrd8.hlp. This file is not installed by default during Office installation so you may have to get it from the Office installation program.<br/>
<br/>
How to open Word using OLE Automation<br/>
<br/>
The CoApplication class defined in the type library represents the implementation of the Word Application interface. Call CoApplication.Create to create an instance of Word. This method will return a pointer to an interface of type _Application. The _Application interface provides a "Documents" interface which provides 2 methods to access documents: Add and Open.<br/>
<br/>
Both these methods return a pointer to a _Document interface. As well these methods take parameters that are of type OLEVariant. Many parameters passed to Word methods are defined as "optional". Optional parameters must be included in calls to methods but can be defined as Unassigned to indicate that they are not being used. Delphi 4 provides a variable which can be used for optional parameters that are not being used called EmptyParam.<br/>
<br/>
Sample Code<br/>
<br/>
uses<br/>
Word_TLB;<br/>
<br/>
procedure StartWord(var WordApp: _Application; var WordDoc: _Document);<br/>
var<br/>
SaveChanges: OleVariant;<br/>
begin<br/>
try<br/>
WordApp := CoApplication.Create;<br/>
WordDoc := WordApp.Documents.Add(EmptyParam, EmptyParam);<br/>
WordApp.Visible := True;<br/>
except<br/>
if Assigned(WordApp) then<br/>
begin<br/>
SaveChanges := wdDoNotSaveChanges;<br/>
WordApp.Quit(SaveChanges, EmptyParam, EmptyParam);<br/>
end;<br/>
end;<br/>
<br/>
How to connect to a running copy of Word<br/>
<br/>
To connect to a running instance of Word use the Delphi command GetActiveOleObject. This will return an IDispatch variable which points to the Word Application. You can then query the return object using QueryInterface to get the pointer to the _Application object. GetActiveOleObject will raise an exception if an instance of the object does not exist in the Running Object Table (ROT) so make sure to wrap the call in a try..except block.<br/>
<br/>
Sample Code<br/>
<br/>
uses<br/>
Word_TLB;<br/>
<br/>
procedure StartWord(var WordApp: _Application);<br/>
var<br/>
SaveChanges: OleVariant;<br/>
begin<br/>
try<br/>
GetActiveOleObject('Word.Application').QueryInterface(_Application, WordApp);<br/>
except<br/>
WordApp := nil;<br/>
end;<br/>
<br/>
if Unassigned(WordApp) then<br/>
begin<br/>
try<br/>
WordApp := CoApplication.Create;<br/>
WordApp.Visible := True;<br/>
except<br/>
if Assigned(WordApp) then<br/>
begin<br/>
SaveChanges := wdDoNotSaveChanges;<br/>
WordApp.Quit(SaveChanges, EmptyParam, EmptyParam);<br/>
end;<br/>
end;<br/>
end;<br/>
end;<br/>
<br/>
Getting data from Word<br/>
<br/>
The Word Document object supports the IDataObject Interface. To get data from Word (RTF, text, structured storage etc) the IDataObject must be used. To get a pointer to the IDataObject Interface use QueryInterface. Word documents support the standard formats CF_TEXT and CF_METAFILEPICT as well as a number of other specific formats including RTF and structured storage. For the standard formats the constant values can be used for the value of cfFormat, but for the other formats the Document must be queried using the function EnumFormatEtc. This function will return a list of supported formats. The required format from this list is then passed to the GetData function of the IDataObject interface. It is important to note that the value of cfFormat for the proprietary formats (RTF etc.) is not constant between machines so it must always be found using EnumFormatEtc and not hard coded. For more information on IDataObject and its methods refer to the Win32 programming help files (included with Delphi 4, C++Builder, Visual C++ etc.).<br/>
<br/>
Sample Code<br/>
<br/>
uses<br/>
Word_TLB;<br/>
<br/>
function GetRTFFormat(DataObject: IDataObject; var RTFFormat: TFormatEtc): Boolean;<br/>
var<br/>
Formats: IEnumFORMATETC;<br/>
TempFormat: TFormatEtc;<br/>
cfRTF: LongWord;<br/>
Found: Boolean;<br/>
begin<br/>
try<br/>
OleCheck(DataObject.EnumFormatEtc(DATADIR_GET, Formats));<br/>
cfRTF := RegisterClipboardFormat('Rich Text Format');<br/>
Found := False;<br/>
while (not Found) and (Formats.Next(1, TempFormat, nil) = S_OK) do<br/>
if (TempFormat.cfFormat = cfRTF) then<br/>
begin<br/>
RTFFormat := TempFormat;<br/>
Found := True;<br/>
end;<br/>
Result := Found;<br/>
except<br/>
Result := False;<br/>
end;<br/>
end;<br/>
<br/>
procedure GetRTF(WordDoc: _Document);<br/>
var<br/>
DataObject: IDataObject;<br/>
RTFFormat: TFormatEtc;<br/>
ReturnData: TStgMedium;<br/>
Buffer: PChar;<br/>
begin<br/>
if Assigned(WordDoc) then<br/>
begin<br/>
try<br/>
WordDoc.QueryInterface(IDataObject, DataObject);<br/>
if GetRTFFormat(DataObject, RTFFormat) then<br/>
begin<br/>
OleCheck(DataObject.GetData(RTFFormat, ReturnData));<br/>
// RTF is passed through global memory<br/>
Buffer := GlobalLock(ReturnData.hglobal);<br/>
<br/>
{ Buffer is a pointer to the RTF text<br/>
Insert code here to handle the RTF text (ie. save it, display it etc.) }<br/>
GlobalUnlock(ReturnData.hglobal);<br/>
end;<br/>
except<br/>
ShowMessage('Error while getting RTF');<br/>
end;<br/>
end;<br/>
end;<br/>
<br/>
Event Sinking with Word<br/>
<br/>
There are 2 ways that event sinking can be performed on Word:<br/>
<br/>
1. Using the IAdviseSink interface<br/>
<br/>
To use the IAdviseSink interface you must first write an object that implements this standard interface. This object is then passed to the DAdvise method of a Word Document's IDataObject interface or to the Advise method of a Word Document's IOleObject interface. Refer to the help MS help on IAdviseSink for more information on this interface.<br/>
<br/>
2. Using ConnectionPoints<br/>
<br/>
Word provides the following event sources that can be sinked to:<br/>
<br/>
ApplicationEvents:<br/>
<br/>
procedure Startup; dispid 1;<br/>
procedure Quit; dispid 2;<br/>
procedure DocumentChange; dispid 3;<br/>
<br/>
DocumentEvents:<br/>
<br/>
procedure New; dispid 4;<br/>
procedure Open; dispid 5;<br/>
procedure Close; dispid 6;<br/>
<br/>
OCXEvents:<br/>
<br/>
procedure GotFocus; dispid -2147417888;<br/>
procedure LostFocus; dispid -2147417887;<br/>
<br/>
To start a connection with Word you must get the IConnectionPointContainer for the Word application or document (depending what events you want to sink to). Next query the IConnectionPointContainer for the IConnectionPoint that you wish to use (ApplicationEvents, DocumentEvents or OCXEvents in this case). Once you have the IConnectionPoint use the Advise method to establish the connection.<br/>
<br/>
There appears to be some limitations with Word's implementation of connection points. When a document is closed in Word, without closing Word itself, Word sends a DocumentEvents.Close message and then an ApplicationEvents.DocumentChange message. Then when Word is closed nothing is sent. On the other hand if Word is closed with an open document then it sends a DocumentEvents.Close message and an ApplicationEvents.Quit message. Another problem is that Word will send the DocumentEvents.Close message when the user "closes" the document but before the "Do you wish to save changes?" dialog is shown. So if the user then selects cancel the document is never closed but the DocumentEvents.Close message was sent.<br/>
<br/>
Sample Code (StartingConnection)<br/>
<br/>
uses<br/>
Word_TLB, activex, comobj, ConnectionObject<br/>
<br/>
// ConnectionObject is the unit containing TWordConnection<br/>
<br/>
procedure StartWordConnection(WordApp: _Application;<br/>
WordDoc: _Document;<br/>
var WordSink: TWordConnection);<br/>
var<br/>
PointContainer: IConnectionPointContainer;<br/>
Point: IConnectionPoint;<br/>
begin<br/>
try<br/>
{ TWordConnection is the COM object which receives the<br/>
notifications from Word. Make sure to free WordSink when<br/>
you are done with it. }<br/>
WordSink := TWordConnection.Create;<br/>
WordSink.WordApp := WordApp;<br/>
WordSink.WordDoc := WordDoc;<br/>
<br/>
// Sink with a Word application<br/>
OleCheck(WordApp.QueryInterface(IConnectionPointContainer, PointContainer));<br/>
if Assigned(PointContainer) then<br/>
begin<br/>
OleCheck(PointContainer.FindConnectionPoint(ApplicationEvents, Point));<br/>
if Assigned(Point) then<br/>
Point.Advise((WordSink as IUnknown), WordSink.AppCookie);<br/>
end;<br/>
<br/>
// Sink with a Word document<br/>
OleCheck(WordDoc.QueryInterface(IConnectionPointContainer, PointContainer));<br/>
if Assigned(PointContainer) then<br/>
begin<br/>
OleCheck(PointContainer.FindConnectionPoint(DocumentEvents, Point));<br/>
if Assigned(Point) then<br/>
Point.Advise((WordSink as IUnknown), WordSink.DocCookie);<br/>
end;<br/>
except<br/>
on E: Exception do<br/>
ShowMessage(E.Message);<br/>
end;<br/>
end;<br/>
<br/>
Sample Code (Connection Object)<br/>
<br/>
unit ConnectionObject;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Word_TLB;<br/>
<br/>
type<br/>
TWordConnection = class(TObject, IUnknown, IDispatch)<br/>
protected<br/>
<br/>
{ IUnknown }<br/>
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;<br/>
function _AddRef: Integer; stdcall;<br/>
function _Release: Integer; stdcall;<br/>
<br/>
{ IDispatch }<br/>
function GetIDsOfNames(const IID: TGUID; Names: Pointer;<br/>
NameCount, LocaleID: Integer;<br/>
DispIDs: Pointer): HResult; stdcall;<br/>
function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;<br/>
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;<br/>
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;<br/>
Flags: Word; var Params;<br/>
VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;<br/>
<br/>
public<br/>
WordApp: _Application;<br/>
WordDoc: _Document;<br/>
AppCookie, DocCookie: Integer;<br/>
end;<br/>
<br/>
implementation<br/>
<br/>
uses<br/>
Windows, ActiveX, Main;<br/>
<br/>
procedure LogComment(comment: string);<br/>
begin<br/>
Form1.Memo1.Lines.Add(comment);<br/>
end;<br/>
<br/>
{ IUnknown Methods }<br/>
<br/>
function TWordConnection._AddRef: Integer;<br/>
begin<br/>
Result := 2;<br/>
end;<br/>
<br/>
function TWordConnection._Release: Integer;<br/>
begin<br/>
Result := 1;<br/>
end;<br/>
<br/>
function TWordConnection.QueryInterface(const IID: TGUID; out Obj): HResult;<br/>
begin<br/>
Result := E_NOINTERFACE;<br/>
Pointer(Obj) := nil;<br/>
if GetInterface(IID, Obj) then<br/>
Result := S_OK;<br/>
if (not Succeeded(Result)) then<br/>
if IsEqualIID(IID, DocumentEvents) or IsEqualIID(IID, ApplicationEvents) then<br/>
if GetInterface(IDispatch, Obj) then<br/>
Result := S_OK;<br/>
end;<br/>
<br/>
{ IDispatch Methods }<br/>
<br/>
function TWordConnection.GetIDsOfNames(const IID: TGUID; Names: Pointer;<br/>
NameCount, LocaleID: Integer;<br/>
DispIDs: Pointer): HResult;<br/>
begin<br/>
Result := E_NOTIMPL;<br/>
end;<br/>
<br/>
function TWordConnection.GetTypeInfo(Index, LocaleID: Integer;<br/>
out TypeInfo): HResult;<br/>
begin<br/>
Pointer(TypeInfo) := nil;<br/>
Result := E_NOTIMPL;<br/>
end;<br/>
<br/>
function TWordConnection.GetTypeInfoCount(out Count: Integer): HResult;<br/>
begin<br/>
Count := 0;<br/>
Result := E_NOTIMPL;<br/>
end;<br/>
<br/>
function TWordConnection.Invoke(DispID: Integer; const IID: TGUID;<br/>
LocaleID: Integer; Flags: Word;<br/>
var Params; VarResult, ExcepInfo,<br/>
ArgErr: Pointer): HResult;<br/>
begin<br/>
// This is the entry point for Word event sinking<br/>
Result := S_OK;<br/>
case DispID of<br/>
1: ; // Startup<br/>
2: ; // Quit<br/>
3: ; // Document change<br/>
4: ; // New document<br/>
5: ; // Open document<br/>
6: ; // Close document<br/>
else<br/>
Result := E_INVALIDARG;<br/>
end;<br/>
end;<br/>
<br/>
end.<br/>
<br/>
Call Delphi from Word (VBA)<br/>
<br/>
Make your Delphi application an OLE Automation server (TAutoObject). File..New..ActiveX..Automation Object. Define your interface(s) and write the methods that you wish to call from Word.<br/>
In VBA add your Delphi exe to the project. Tools..References. You should now be able to use the VBA Object Browser to (F2) to browse your Delphi functions.<br/>
Code a VBA procedure to call Delphi.<br/>
<br/>
Sample Code<br/>
<br/>
Sub foo<br/>
' AutoServer is the name of the class<br/>
' in the object browser<br/>
Dim MyServer as AutoServer<br/>
<br/>
System.Cursor = wdCursorWait<br/>
<br/>
set MyServer = new AutoServer<br/>
Call MyServer.DelphiFoo(p1, p2)<br/>
<br/>
System.Cursor = wdCursorNormal<br/>
end Sub<br/>
<br/>
<br/>
<br/>
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-29114083804910712472011-06-09T15:00:00.001-07:002011-06-25T03:32:01.301-07:00Send an email with an attachment
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to send an email with an attachment<br/>
<br/>
Answer:<br/>
<br/>
Solve 1:<br/>
<br/>
For Outlook mail:<br/>
<br/>
uses<br/>
ComObj;<br/>
<br/>
procedure MailItem;<br/>
const<br/>
olMailItem = 0;<br/>
var<br/>
Outlook: OLEVariant;<br/>
MailItem: Variant;<br/>
begin<br/>
try<br/>
Outlook := GetActiveOleObject('Outlook.Application');<br/>
except<br/>
Outlook := CreateOleObject('Outlook.Application');<br/>
end;<br/>
MailItem := Outlook.CreateItem(olMailItem);<br/>
MailItem.Recipients.Add(< email address here > );<br/>
MailItem.Subject := 'your subject';<br/>
MailItem.Body := 'This is sample text';<br/>
MailItem.Attachments.Add('C:\Windows\Win.ini');<br/>
MailItem.Send;<br/>
Outlook := Unassigned;<br/>
end;<br/>
<br/>
<br/>
Solve 2:<br/>
<br/>
There have been many questions about how to send an e-mail with an attachment. I came up with the vbs script that did it with Outlook.<br/>
<br/>
Well here's the Delphi translation that uses OLE to accomplish the same thing:<br/>
<br/>
Change recipientaddress@recipienthost.com to your own e-mail address and give it a try. You must have Outlook installed, I'm not sure if this will work with Outlook Express.<br/>
<br/>
procedure TForm1.Button1Click(Sender: TObject);<br/>
const<br/>
{ OlItemType constants }<br/>
olMailItem = 0;<br/>
olAppointmentItem = 1;<br/>
olContactItem = 2;<br/>
olTaskItem = 3;<br/>
olJournalItem = 4;<br/>
olNoteItem = 5;<br/>
olPostItem = 6;<br/>
{ OlAttachmentType constants }<br/>
olByValue = 1;<br/>
olByReference = 4;<br/>
olEmbeddedItem = 5;<br/>
olOLE = 6;<br/>
var<br/>
myOlApp, myItem, myRecipient, myAttachments: OleVariant;<br/>
begin<br/>
{ VBScript file to create a mail and add an attachment }<br/>
myOlApp := CreateOLEObject('Outlook.Application');<br/>
myItem := myOlApp.CreateItem(olMailItem);<br/>
myItem.Subject := 'This is the Subject';<br/>
myRecipient := myItem.Recipients.Add('recipientaddress@recipienthost.com');<br/>
myItem.Body := #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'Hello,' + #13;<br/>
myItem.Body := myItem.Body + 'This code created this message and ' +<br/>
' sent it and I didn'' t even have' + #13;<br/>
myItem.Body := myItem.Body + 'to click the send button!!!' + #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'If you have any more problems, let me know' + #13;<br/>
myItem.Body := myItem.Body + 'rename to blah.vbs and run like this:' + #13;<br/>
myItem.Body := myItem.Body + 'wscript c:\blah.vbs' + #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'MrBaseball34' + #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'const' + #13;<br/>
myItem.Body := myItem.Body + ' // OlItemType constants' + #13;<br/>
myItem.Body := myItem.Body + ' olMailItem = 0;' + #13;<br/>
myItem.Body := myItem.Body + ' olAppointmentItem = 1;' + #13;<br/>
myItem.Body := myItem.Body + ' olContactItem = 2;' + #13;<br/>
myItem.Body := myItem.Body + ' olTaskItem = 3;' + #13;<br/>
myItem.Body := myItem.Body + ' olJournalItem = 4;' + #13;<br/>
myItem.Body := myItem.Body + ' olNoteItem = 5;' + #13;<br/>
myItem.Body := myItem.Body + ' olPostItem = 6;' + #13;<br/>
myItem.Body := myItem.Body + ' // OlAttachmentType constants' + #13;<br/>
myItem.Body := myItem.Body + ' olByValue = 1;' + #13;<br/>
myItem.Body := myItem.Body + ' olByReference = 4;' + #13;<br/>
myItem.Body := myItem.Body + ' olEmbeddedItem = 5;' + #13;<br/>
myItem.Body := myItem.Body + ' olOLE = 6;' + #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'var' + #13;<br/>
myItem.Body := myItem.Body + ' myOlApp, myItem, myRecipient, myAttachments: OleVariant;' + #13;<br/>
myItem.Body := myItem.Body + 'begin' + #13;<br/>
myItem.Body := myItem.Body + ' myOlApp := CreateObject(''Outlook.Application'')' + #13;<br/>
myItem.Body := myItem.Body + ' myItem := myOlApp.CreateItem(olMailItem)' + #13;<br/>
myItem.Body := myItem.Body + ' myItem.Subject := ''This is the Subject''' + #13;<br/>
myItem.Body := myItem.Body + ' myItem.Body := ''This is the body''' + #13;<br/>
myItem.Body := myItem.Body + ' myRecipient :=<br/>
myItem.Recipients.Add('recipientaddress@recipienthost.com')' + #13;<br/>
myItem.Body := myItem.Body + ' myAttachments := myItem.Attachments' + #13;<br/>
myItem.Body := myItem.Body + ' // Now let''s attach the files...' + #13;<br/>
myItem.Body := myItem.Body + ' myAttachments.Add ''C:\blah.txt'', olByValue, 1,<br/>
'' Blah.txt Attachment''' + #13;<br/>
myItem.Body := myItem.Body + ' myItem.Send' + #13;<br/>
myItem.Body := myItem.Body + ' myOlApp := VarNull;' + #13;<br/>
myItem.Body := myItem.Body + ' myItem := VarNull;' + #13;<br/>
myItem.Body := myItem.Body + ' myRecipient := VarNull;' + #13;<br/>
myItem.Body := myItem.Body + ' myAttachments := VarNull;' + #13;<br/>
myItem.Body := myItem.Body + 'end;' + #13;<br/>
{ Now let's attach the files... }<br/>
myAttachments := myItem.Attachments;<br/>
myAttachments.Add('C:\blah.txt', olByValue, 1, 'Blah.txt Attachment');<br/>
myItem.Send;<br/>
myOlApp := VarNull;<br/>
myItem := VarNull;<br/>
myRecipient := VarNull;<br/>
myAttachments := VarNull;<br/>
end;<br/>
<br/>
The way you do it, your string is recreated an shuffled around a lot of times. The way directly above, you'll only have one large string, being slowly filled with the text. So instead of<br/>
<br/>
myItem.Body := #13;<br/>
myItem.Body := myItem.Body + #13;<br/>
myItem.Body := myItem.Body + 'Hello,' + #13;<br/>
myItem.Body := myItem.Body + 'This code created this message and ' +<br/>
' sent it and I didn''t even have' + #13;<br/>
{ etc... }<br/>
<br/>
you could write<br/>
<br/>
myItem.Body := #13 + #13 + 'Hello' + #13 + 'This code created this message and ' +<br/>
'sent it and I didn''t even have' + #13 +<br/>
{ etc... }<br/>
<br/>
<br/>
Solve 3:<br/>
<br/>
uses<br/>
Mapi;<br/>
<br/>
procedure TForm1.Button1Click(Sender: TObject);<br/>
const<br/>
MyToName = 'Name';<br/>
MyToAddress = 'to@domain.com';<br/>
MyCCAddress = 'cc@domain.com';<br/>
MySubject = 'Subject';<br/>
MyBody = 'Some' + #13#10 + 'Text';<br/>
MyFileName = 'c:\config.sys';<br/>
MySendError = 'Error sending mail';<br/>
var<br/>
MyMapiMessage: TMapiMessage;<br/>
MyRecipients: array of TMapiRecipDesc;<br/>
MyAttachments: array of TMapiFileDesc;<br/>
begin<br/>
{Recipient addresses}<br/>
SetLength(MyRecipients, 2);<br/>
FillChar(MyRecipients[0], Length(MyRecipients) * SizeOf(TMapiRecipDesc), 0);<br/>
with MyRecipients[0] do<br/>
begin<br/>
ulRecipClass := MAPI_TO;<br/>
lpszName := PChar(MyToName);<br/>
lpszAddress := PChar(MyToAddress);<br/>
end;<br/>
with MyRecipients[1] do<br/>
begin<br/>
ulRecipClass := MAPI_CC;<br/>
lpszAddress := PChar(MyCCAddress);<br/>
end;<br/>
{Attach a file}<br/>
SetLength(MyAttachments, 1);<br/>
FillChar(MyAttachments[0], SizeOf(MyAttachments), 0);<br/>
MyAttachments[0].nPosition := Cardinal(-1);<br/>
MyAttachments[0].lpszPathName := PChar('' + MyFileName);<br/>
{Fill the message structure}<br/>
FillChar(MyMapiMessage, SizeOf(TMapiMessage), 0);<br/>
with MyMapiMessage do<br/>
begin<br/>
lpszSubject := PChar(MySubject);<br/>
lpszNoteText := PChar(MyBody);<br/>
nRecipCount := Length(MyRecipients);<br/>
lpRecips := @MyRecipients[0];<br/>
if Length(MyAttachments) > 0 then<br/>
begin<br/>
nFileCount := Length(MyAttachments);<br/>
lpFiles := @MyAttachments[0];<br/>
end;<br/>
end;<br/>
if MapiSendMail(0, Application.Handle, MyMapiMessage, MAPI_DIALOG or<br/>
MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) <> 0 then<br/>
MessageDlg(MySendError, mtError, [mbOK], 0);<br/>
end;<br/>
<br/>
<br/>
Solve 4:<br/>
<br/>
procedure TForm1.Button1Click(Sender: TObject);<br/>
var<br/>
App: _Application;<br/>
Item: MailItem;<br/>
begin<br/>
App := CoOutlookApplication.Create;<br/>
Item := App.CreateItem(olMailItem) as MailItem;<br/>
Item.Subject := 'My Subject';<br/>
Item.To_ := 'nobody@nowhere.com';<br/>
Item.Attachments.Add('C:\test.txt', EmptyParam, EmptyParam, EmptyParam);<br/>
Item.Send;<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-33886684437849745432011-06-08T15:00:00.001-07:002011-06-25T03:32:02.124-07:00Merge cells in a TStringGrid
<br/>
Problem/Question/Abstract:<br/>
<br/>
Is it possible to create an OnDrawCell event to draw the cell text in a way that it looks like in Excel? For example, I don't want to truncate the text if the right adjacent cell is empty.<br/>
<br/>
Answer:<br/>
<br/>
You can do that but it is not quite as easy as it may look at first glance. The problem you may run into is that something may invalidate the right adjacent cell in your scenario but not the cell holding the text. So the OnDrawCell event would only fire for the empty cell, not for the one holding the text. So some work has to be done to make sure the cell holding the text is invalidated as well when one of the adjacent cells is invalidated.<br/>
<br/>
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;<br/>
Rect: TRect; State: TGridDrawState);<br/>
var<br/>
i, x, y: Integer;<br/>
begin<br/>
if gdFixed in State then<br/>
Exit;<br/>
if ARow > 1 then<br/>
Exit;<br/>
{Draw row 1 with text from cell 1,1 spanning all cells in the row}<br/>
with sender as TStringGrid do<br/>
begin<br/>
{Extend rect to include grid line on right, if not last cell in row}<br/>
if aCol < Pred(ColCount) then<br/>
Rect.Right := Rect.Right + GridlineWidth;<br/>
{Figure out where the text of the first cell would start relative to the <br/>
current cells rect}<br/>
y := Rect.Top + 2;<br/>
x := Rect.Left + 2;<br/>
for i := 1 to aCol - 1 do<br/>
x := x - ColWidths[i] - GridlineWidth;<br/>
{Paint cell pale yellow}<br/>
Canvas.Brush.Color := $7FFFFF;<br/>
Canvas.Brush.Style := bsSolid;<br/>
Canvas.FillRect(Rect);<br/>
{Paint text of cell 1,1 clipped to current cell}<br/>
Canvas.TextRect(Rect, x, y, Cells[1, 1]);<br/>
end;<br/>
end;<br/>
<br/>
procedure TForm1.FormCreate(Sender: TObject);<br/>
var<br/>
i, k: Integer;<br/>
begin<br/>
with StringGrid1 do<br/>
begin<br/>
cells[1, 1] := 'A rather long line which will span cells';<br/>
for i := 1 to colcount - 1 do<br/>
for k := 2 to rowcount - 1 do<br/>
cells[i, k] := Format('Cell[%d, %d]', [i, k]);<br/>
end;<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-49466682338415884172011-06-07T15:00:00.001-07:002011-06-25T03:32:04.292-07:00Delphi Does ADO
<br/>
Problem/Question/Abstract:<br/>
<br/>
ADO Overview<br/>
<br/>
Answer:<br/>
<br/>
The New Way to Get to Data<br/>
<br/>
Universal Data Access (UDA) is part of Microsoft's strategy to provide fast access to data in both relational and non-relational data stores. UDA provides a language-independent, easy-to-use API for accessing data in any data source that has a UDA-compatible driver. Like the BDE, this technology makes it easy to access data from multiple data sources in a single program. UDA is implemented using the Microsoft Data Access Components (MDAC), which includes Active Data Objects (ADO), Open Database Connectivity (ODBC), and OLE DB. <br/>
<br/>
ADO is the application programming interface of MDAC, while OLE DB is the system-level interface. OLE DB defines a suite of COM interfaces that provide all the data access capabilities required by any data source, from a relational database to a file system. ODBC is included in MDAC for backward compatibility. While existing ODBC drivers will likely be replaced by OLE DB providers in the future, the Microsoft OLE DB provider for ODBC lets you use any ODBC driver via ADO now. Although ADO is relatively new, OLE DB providers are already available for Microsoft Access, Microsoft SQL Server, and Oracle. <br/>
<br/>
Another major advantage of ADO is that it will be built into all future Microsoft operating systems, including Windows 2000. While this means that today you must install ADO on each PC that will use ADO to access data, that task will vanish in the future. If you want to learn more about UDA and ADO, visit Microsoft's data access Web site at http://www.microsoft.com/data/default.htm. From this page, you can download the ADO redistributable, which allows you to install ADO on Windows 95/98/NT machines, or the MDAC SDK, which contains complete documentation and everything you need to develop your own OLE DB providers. The SDK also includes the ADO redistributable. <br/>
<br/>
Everything you need to use ADO with Delphi is on the Delphi 5 CD, including MDAC. Simply go to the MDAC folder on the Delphi 5 CD and run the installation program, MDAC_TYP.EXE. The MDAC installation program is a single EXE file, so it's easy to install MDAC anywhere you need it. You can also use the MDAC installation program to install MDAC as part of your application's installation if you're using an installation program that supports calling EXEs (InstallShield Express does not). If you're installing MDAC as part of your application's installation, you'll want to use the "silent" mode to suppress all screen displays. To install in silent mode, use the command: <br/>
<br/>
mdac_typ.exe /q:a /c:"setup.exe /qt" <br/>
<br/>
For more information on installing MDAC, including file lists and dependencies, see the MDAC SDK documentation. <br/>
<br/>
Using the ADOConnection and ADODataSet Components<br/>
<br/>
Delphi 5 has a suite of six new components that provide complete ADO support, and an easy way to convert existing applications to ADO. To begin building an ADO application, drop an ADOConnection component on a form or data module. The ADOConnection component is the ADO equivalent of the BDE Database component. It allows you to define a connection to a database using its ConnectionString property. <br/>
<br/>
While it's possible to build a connection string manually, it is difficult. The ADO connection string consists of a semicolon-delimited list of many parameters that can easily exceed 150 characters. Fortunately, Microsoft provides a Connection String Editor to make this job easier. To open the Connection String Editor, shown in Figure 1, click the ellipsis button in the ConnectionString property's edit box, or double-click on the component. <br/>
<br/>
<br/>
Figure 1: The Connection String Editor. <br/>
<br/>
The easy way to build a connection string is to click the Build button to display the Data Link Properties dialog box, shown in Figure 2. The Provider page lets you choose the driver you want to use. <br/>
<br/>
<br/>
Figure 2: The Data Link Properties dialog box.<br/>
<br/>
What you see on the Connection page depends on the provider you select. Figure 3 shows the Connection page with the Microsoft Jet provider selected, and the path to an Access database entered. <br/>
<br/>
<br/>
Figure 3: The Connection page. <br/>
<br/>
The Advanced page, shown in Figure 4, lets you specify the type of access to the database, and the All page (see Figure 5) lets you edit any value in the connection string. The All page is particularly important if you're connecting to an Access database with user-level security, because it's the only place you can enter the path to the system database. <br/>
<br/>
<br/>
Figure 4: The Advanced page. <br/>
<br/>
<br/>
Figure 5: The All page. <br/>
<br/>
Once a value has been assigned to the ConnectionString property, you can set the Connected property to True, at design or run time, to connect to the database. The ADOConnection component also provides transaction support through its BeginTrans, CommitTrans, and RollbackTrans methods. <br/>
<br/>
The ADODataSet component is really the only one you need to work with data because it allows you to work directly with a table, execute a SQL statement, work with the result set, or call a stored procedure. After dropping an ADODataSet on a form or data module, the first step is to set its Connection property. The Connection property's drop-down list will display all the available ADOConnection components. Next, you need to set two related properties: CommandType and CommandText. Set CommandType first because it determines how CommandText is interpreted. You can set CommandType to indicate that you want to connect directly to a table, call a stored procedure, or enter a SQL statement as text. Choosing cmdTable as the CommandType causes the drop-down list for the CommandText property to display the tables in the database. <br/>
<br/>
Once CommandType and CommandText have been set, using the ADO components is exactly like working with the BDE dataset components. Drop a DataSource component, a DBNavigator, and some data-aware components on your form. Set the DataSet property of the DataSource to the ADODataSet component, and set the DataSource property of the navigator and data-aware controls. <br/>
<br/>
Figure 6 shows a data module containing an ADOConnection, two ADODataSet components, and two DataSource components modeling a one-to-many relationship between two tables in an Access database. The master table is FailureAdoDs, and the detail table is RepairTimeAdoDs. The datasets were linked by setting the DataSource property of the detail dataset to the DataSource component of the master dataset, then setting the MasterFields property of the detail dataset. <br/>
<br/>
<br/>
Figure 6: Linked ADODataSet components. <br/>
<br/>
The property editor for the MasterFields property is the Field Link Designer, shown in Figure 7. To link the tables, select the master and detail fields that define the relationship between the tables, and click the Add button. In this example, the TrackingNumber field links the tables. If the relation is defined by more than one field, repeat the process of selecting the corresponding master and detail fields and clicking the Add button. <br/>
<br/>
<br/>
Figure 7: The Field Link Designer. <br/>
<br/>
To use an ADODataSet with a query result set, change the CommandType to cmdText and enter the SQL statement in the CommandText property. With the CommandType set to cmdText, the property editor for the CommandText property changes to the Command Text Editor, shown in Figure 8. <br/>
<br/>
<br/>
Figure 8: The Command Text Editor. <br/>
<br/>
The Command Text Editor is a major improvement over the String List Editor, used to edit SQL commands in previous versions of Delphi. It provides a list of tables, and a button to add the table name to the SQL statement, as well as a list of field names for the selected table. Even if you don't use the Add buttons, the list of table and field names is very handy. Creating a one-to-many link between the ADODataSet components that execute SQL statements is exactly the same as linking two BDE Query components. The SQL statement for the detail dataset is: <br/>
<br/>
SELECT * <br/>
FROM RepairTime<br/>
WHERE TrackingNumber = :TrackingNumber<br/>
<br/>
The name of the parameter in the WHERE clause, :TrackingNumber, matches the name of the primary key in the master table exactly. The detail dataset's DataSource property is set to the master table's DataSource component. Because these two conditions have been met, each time the master dataset is positioned to a new record, the detail dataset is automatically closed, the new value from the master record is assigned to the query parameter, and the detail dataset is opened to retrieve the new set of detail records. <br/>
<br/>
If you will execute a query more than once with different parameters, set the ADODataSet's Prepared property to True. This will cause the query plan to be prepared and stored the first time the query is executed. The stored plan will be used for each subsequent execution. This eliminates the time required to parse and optimize the query for all executions except the first. <br/>
<br/>
To work with a stored procedure, set the CommandType to cmdStoredProc, and choose the stored procedure from the CommandText property's drop-down list. Use the ADODataSet's Parameters property to assign values to input parameters and retrieve values from output parameters. <br/>
<br/>
Although you can do everything with the ADODataSet component, Delphi 5 also includes the ADOTable, ADOQuery, and ADOStoredProc components. These are designed to resemble the BDE Table, Query, and StoredProc components as closely as possible to make converting an application to ADO easy. <br/>
<br/>
Should You Convert to ADO? <br/>
<br/>
Why convert an existing application from BDE to ADO? Neither the native BDE Access driver nor the Access ODBC driver have been ideal solutions for working with Access databases. Using the ADO Jet driver eliminates these problems. With ADO, your Access applications will correctly detect changes made by other users and warn you when you try to post a record that has been changed by another user since you read it. Also, Autoincrement fields work correctly with default values set for other fields. <br/>
<br/>
The big advantage of using ADO with any database, however, is that you are no longer dependent on Borland to update drivers when new releases of the database appear. When a new version of SQL Server or Oracle is released, the new ADO drivers should be available at the same time, and should work because the database vendor writes them. <br/>
<br/>
The ADOCommand Component<br/>
<br/>
In addition to the components for working with datasets, Delphi 5 also provides the ADOCommand component. The ADOCommand component is most useful for executing commands that don't return a result set, such as SQL DDL (Data Definition Language) commands, or a SQL DELETE query. <br/>
<br/>
If you're using one or more ADOConnection components, click the drop-down button in the Connection property of the ADOCommand component and select the connection you want to use. The ADOCommand component, like all the ADO dataset components, has its own ConnectionString property so you don't have to use an ADOConnection component. However, in most cases, you'll want to. The connection component provides a single central place to change the ConnectionString and any other connection-related properties, as well as providing transaction control methods. <br/>
<br/>
The CommandText property of the ADOCommand component contains the command you want to execute, and the CommandType property determines whether CommandText is interpreted as a text string, table name, or stored procedure name. Set CommandType to ctText to execute a SQL statement. If the SQL statement includes parameters, you can set their properties using the Parameters property editor of the ADOCommand component. Although it makes no sense to use the ADOCommand component to retrieve a dataset from a table, query, or stored procedure, you can do it. The ADOCommand's Execute method returns the recordset generated by the command, if any. You can assign the returned recordset to the RecordSet property of an ADODataSet to view the records. <br/>
<br/>
Cursor Types<br/>
<br/>
If you're accustomed to working with the BDE dataset components, there are a number of things you'll find different when you use ADO. One of the most striking is the choice of four different cursor types, which you can set using the CursorType property of ADODataSet. The first is ctStatic, which provides a static dataset that you cannot edit, and that will not show any changes made by other users. A static cursor behaves like the result set from a BDE Query component with its RequestLive property set to False. <br/>
<br/>
Choosing ctOpenForwardOnly provides a cursor that is identical to a static cursor, except that you can only move forward through the dataset. A forward-only cursor is very efficient and is ideal for generating reports. Setting the CursorType to ctDynamic provides a cursor that allows you to navigate both forward and backward, as well as see all additions, deletions, and changes made by other users. The ctKeySet cursor type is identical to ctDynamic except that you can't see records added by other users. <br/>
<br/>
ADO also provides a CursorLocation property with two possible values: clUseClient and clUseServer. Client cursors are somewhat similar to data provided to a MIDAS ClientDataSet, in that all the data is downloaded to the client immediately. For a large dataset, this can impose a significant penalty in time and memory usage. However, client cursors are almost always updateable, support bookmarks, and allow scrolling in both directions. This may not always be true with server cursors. The features available with server cursors will depend on the database and the OLE DB provider you're using. <br/>
<br/>
Transaction Isolation Levels<br/>
<br/>
ADO supports the ANSI SQL-92 standard transaction isolation levels, which are slightly different than those supported by the Delphi Database component's TransIsolation property. ADO supports the following four isolation levels: <br/>
<br/>
Read Uncommitted. Read Uncommitted is also called Dirty Read or Browse isolation. At this level of isolation, a transaction can see uncommitted changes made by other transactions. <br/>
Read Committed. A transaction at this level cannot see uncommitted changes made by other transactions, but can see committed changes. This means that reading the same record twice may give two different values because the record could have been changed by another transaction that has committed. If a query is re-executed within the transaction, it can also return new records that have been added by another committed transaction that it did not see the first time the query ran. <br/>
Repeatable Read. A Repeatable Read transaction will not see any changes made by other transactions to records it has read, even if the other transactions have committed. However, if a query is re-executed within the transaction, it will see new records added by other committed transactions. <br/>
Serializable. This isolation level requires that all concurrent transactions interact in ways that produce the same result as though the transactions executed sequentially. A transaction at this level will not see either changed or newly inserted records from other committed transactions. <br/>
<br/>
Of course, the isolation level that you actually get when you choose one of these options depends on the isolation levels that the database you're using supports. <br/>
<br/>
Conclusion<br/>
<br/>
ADO support is the single most important feature for database application developers in Delphi 5. As Microsoft builds ADO into its next generation of operating systems, you'll no longer have to install additional software with your application to access databases. Perhaps more important is the range of data that ADO will provide access to in the future. Looking beyond relational databases, ADO will provide access to e-mail system message stores, the file system on your hard disk, and any other data store in a Microsoft product. <br/>
<br/>
With the full power of Microsoft behind it, ADO will certainly be adopted by other vendors with products that store data. Finally, ADO relieves Borland of the burden of writing drivers. That is a bigger benefit to you than to Borland because it means you'll get better drivers faster, as new versions of data storage products ship. Best of all, because ADO drivers for Access, SQL Server, and Oracle are already available, and because ADO includes an ODBC provider, you can start using it right now.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-43994879198327876682011-06-06T15:00:00.001-07:002011-06-25T03:32:05.455-07:00How to convert a String To a PChar and PChar to String
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to convert a String To a PChar and PChar to String<br/>
<br/>
Answer:<br/>
<br/>
function ConvertStringToPChar(StringValue: string): PChar;<br/>
var<br/>
PCharString: array[0..255] of Char;<br/>
begin<br/>
Result := StrPCopy(PCharString, StringValue);<br/>
end;<br/>
<br/>
function ConvertPCharToString(PCharValue: PChar): string;<br/>
begin<br/>
Result := StrPas(PCharValue);<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-91165762132013806472011-06-05T15:00:00.001-07:002011-06-25T03:32:07.343-07:00BDE error codes
<br/>
Problem/Question/Abstract:<br/>
<br/>
BDE error codes<br/>
<br/>
Answer:<br/>
<br/>
Additional information about BDE error codes are available in file \DELPHI\DOC\DBIERRS.INT.<br/>
<br/>
<br/>
0 0000 Successful completion.<br/>
33 0021 System Error<br/>
34 0022 Object of Interest Not Found<br/>
35 0023 Physical Data Corruption<br/>
36 0024 I/O Related Error<br/>
37 0025 Resource or Limit Error<br/>
38 0026 Data Integrity Violation<br/>
39 0027 Invalid Request<br/>
40 0028 Lock Violation<br/>
41 0029 Access/Security Violation<br/>
42 002A Invalid Context<br/>
43 002B OS Error<br/>
44 002C Network Error<br/>
45 002D Optional Parameter<br/>
46 002E Query Processor<br/>
47 002F Version Mismatch<br/>
48 0030 Capability Not Supported<br/>
49 0031 System Configuration Error<br/>
50 0032 Warning<br/>
51 0033 Miscellaneous<br/>
52 0034 Compatibility Error<br/>
62 003E Driver Specific Error<br/>
63 003F Internal Symbol<br/>
256 0100 KEYVIOL<br/>
257 0101 PROBLEMS<br/>
258 0102 CHANGED<br/>
512 0200 Production Index file missing, corrupt or cannot interpret index key<br/>
513 0201 Open Read Only<br/>
514 0202 Open the table in read only mode<br/>
515 0203 Open and Detach<br/>
516 0204 Open the table and detach the Production Index file<br/>
517 0205 Fail Open<br/>
518 0206 Do not open the table<br/>
519 0207 Convert Non-dBase Index<br/>
520 0208 Convert production index to dBase format<br/>
521 0209 BLOB file not found<br/>
522 020A Open without blob file<br/>
523 020B Open the table without the blob file<br/>
524 020C Empty all blob fields<br/>
525 020D Reinitialize BLOB file and LOSE all blobs<br/>
526 020E Fail Open<br/>
527 020F Do not open the table<br/>
528 0210 Import Non-dBASE BLOB file<br/>
529 0211 Import BLOB file to dBASE format<br/>
530 0212 Open as Non-dBASE table<br/>
531 0213 Open Table and BLOB file in its native format<br/>
532 0214 Production Index Language driver mismatch<br/>
533 0215 Production Index damaged<br/>
534 0216 Rebuild Production Index<br/>
535 0217 Rebuild all the Production Indexes<br/>
1024 0400 Lookup table not found or corrupt<br/>
1025 0401 Blob file not found or corrupt<br/>
1026 0402 Open Read Only<br/>
1027 0403 Open the table in read only mode<br/>
1028 0404 Fail Open<br/>
1029 0405 Do not open the table<br/>
1030 0406 Remove lookup<br/>
1031 0407 Remove link to lookup table<br/>
2048 0800 Reading records<br/>
2049 0801 Sorting records<br/>
2050 0802 Writing records<br/>
2051 0803 Merging<br/>
2052 0804 Steps Completed<br/>
2053 0805 Packing records<br/>
2309 0905 LIKE<br/>
2310 0906 NOT<br/>
2320 0910 INSERT<br/>
2321 0911 DELETE<br/>
2322 0912 CHANGETO<br/>
2323 0913 CHANGE<br/>
2324 0914 TO<br/>
2325 0915 FIND<br/>
2326 0916 CALC<br/>
2327 0917 COUNT<br/>
2328 0918 SUM<br/>
2329 0919 AVERAGE<br/>
2330 091A MAX<br/>
2331 091B MIN<br/>
2332 091C ALL<br/>
2333 091D UNIQUE<br/>
2334 091E BLANK<br/>
2335 091F TODAY<br/>
2336 0920 AS<br/>
2337 0921 DESCENDING<br/>
2338 0922 OR<br/>
2339 0923 ONLY<br/>
2340 0924 EVERY<br/>
2341 0925 NO<br/>
2342 0926 EXACTLY<br/>
2343 0927 SET<br/>
2347 092B %time<br/>
2348 092C %date<br/>
2353 0931 %lower<br/>
2354 0932 %upper<br/>
2355 0933 %trim<br/>
2356 0934 %substring<br/>
2364 093C __QB0000<br/>
2365 093D ANSWER<br/>
2366 093E DELETED<br/>
2367 093F INSERTED<br/>
2368 0940 CHANGED<br/>
2369 0941 ERRORDEL<br/>
2370 0942 ERRORINS<br/>
2371 0943 ERRORCHG<br/>
2372 0944 __XLTTMP<br/>
2373 0945 __QBEDIC<br/>
2405 0965 JAN<br/>
2406 0966 FEB<br/>
2407 0967 MAR<br/>
2408 0968 APR<br/>
2409 0969 MAY<br/>
2410 096A JUN<br/>
2411 096B JUL<br/>
2412 096C AUG<br/>
2413 096D SEP<br/>
2414 096E OCT<br/>
2415 096F NOV<br/>
2416 0970 DEC<br/>
2423 0977 INSERTED.DB<br/>
2424 0978 CHANGED.DB<br/>
2425 0979 DELETED.DB<br/>
2426 097A ANSWER.DB<br/>
2427 097B blank<br/>
2428 097C Sum of<br/>
2429 097D Average of<br/>
2430 097E Count of<br/>
2431 097F Max of<br/>
2432 0980 Min of<br/>
2433 0981 GROUPBY<br/>
2434 0982 FIELDORDER<br/>
2435 0983 SORT<br/>
2436 0984 ANSWER<br/>
2437 0985 TYPE<br/>
2438 0986 OPTIONS<br/>
2440 0988 GENERATE AUXILIARY TABLES<br/>
2441 0989 NO AUXILIARY TABLES<br/>
2442 098A SERVER<br/>
2443 098B LOCAL<br/>
2444 098C CANNED<br/>
2445 098D LIVE<br/>
2446 098E SPEED<br/>
2447 098F %extract<br/>
2448 0990 DATE<br/>
2449 0991 TIME<br/>
2450 0992 YEAR<br/>
2451 0993 MONTH<br/>
2452 0994 DAY<br/>
2453 0995 HOUR<br/>
2454 0996 MINUTE<br/>
2455 0997 SECOND<br/>
8449 2101 Cannot open a system file.<br/>
8450 2102 I/O error on a system file.<br/>
8451 2103 Data structure corruption.<br/>
8452 2104 Cannot find Engine configuration file.<br/>
8453 2105 Cannot write to Engine configuration file.<br/>
8454 2106 Cannot initialize with different configuration file.<br/>
8455 2107 System has been illegally re-entered.<br/>
8456 2108 Cannot locate IDAPI01.DLL<br/>
8457 2109 Cannot load IDAPI01.DLL<br/>
8458 210A Cannot load an IDAPI service library<br/>
8705 2201 At beginning of table.<br/>
8706 2202 At end of table.<br/>
8707 2203 Record moved because key value changed.<br/>
8708 2204 Record/Key deleted.<br/>
8709 2205 No current record.<br/>
8710 2206 Could not find record.<br/>
8711 2207 End of BLOB.<br/>
8712 2208 Could not find object.<br/>
8713 2209 Could not find family member.<br/>
8714 220A BLOB file is missing.<br/>
8715 220B Could not find language driver.<br/>
8961 2301 Corrupt table/index header.<br/>
8962 2302 Corrupt file - other than header.<br/>
8963 2303 Corrupt Memo/BLOB file.<br/>
8965 2305 Corrupt index.<br/>
8966 2306 Corrupt lock file.<br/>
8967 2307 Corrupt family file.<br/>
8968 2308 Corrupt or missing .VAL file.<br/>
8969 2309 Foreign index file format.<br/>
9217 2401 Read failure.<br/>
9218 2402 Write failure.<br/>
9219 2403 Cannot access directory.<br/>
9220 2404 File Delete operation failed.<br/>
9221 2405 Cannot access file.<br/>
9222 2406 Access to table disabled because of previous error.<br/>
9473 2501 Insufficient memory for this operation.<br/>
9474 2502 Not enough file handles.<br/>
9475 2503 Insufficient disk space.<br/>
9476 2504 Temporary table resource limit.<br/>
9477 2505 Record size is too big for table.<br/>
9478 2506 Too many open cursors.<br/>
9479 2507 Table is full.<br/>
9480 2508 Too many sessions from this workstation.<br/>
9481 2509 Serial number limit (Paradox).<br/>
9482 250A Some internal limit (see context).<br/>
9483 250B Too many open tables.<br/>
9484 250C Too many cursors per table.<br/>
9485 250D Too many record locks on table.<br/>
9486 250E Too many clients.<br/>
9487 250F Too many indexes on table.<br/>
9488 2510 Too many sessions.<br/>
9489 2511 Too many open databases.<br/>
9490 2512 Too many passwords.<br/>
9491 2513 Too many active drivers.<br/>
9492 2514 Too many fields in Table Create.<br/>
9493 2515 Too many table locks.<br/>
9494 2516 Too many open BLOBs.<br/>
9495 2517 Lock file has grown too large.<br/>
9496 2518 Too many open queries.<br/>
9498 251A Too many BLOBs.<br/>
9729 2601 Key violation.<br/>
9730 2602 Minimum validity check failed.<br/>
9731 2603 Maximum validity check failed.<br/>
9732 2604 Field value required.<br/>
9733 2605 Master record missing.<br/>
9734 2606 Master has detail records. Cannot delete or modify.<br/>
9735 2607 Master table level is incorrect.<br/>
9736 2608 Field value out of lookup table range.<br/>
9737 2609 Lookup Table Open operation failed.<br/>
9738 260A Detail Table Open operation failed.<br/>
9739 260B Master Table Open operation failed.<br/>
9740 260C Field is blank.<br/>
9741 260D Link to master table already defined.<br/>
9742 260E Master table is open.<br/>
9743 260F Detail table(s) exist.<br/>
9744 2610 Master has detail records. Cannot empty it.<br/>
9745 2611 Self referencing referential integrity must be entered one at a time with no other changes to the table<br/>
9746 2612 Detail table is open.<br/>
9747 2613 Cannot make this master a detail of another table if its details are not empty.<br/>
9748 2614 Referential integrity fields must be indexed.<br/>
9749 2615 A table linked by referential integrity requires password to open.<br/>
9750 2616 Field(s) linked to more than one master.<br/>
9985 2701 Number is out of range.<br/>
9986 2702 Invalid parameter.<br/>
9987 2703 Invalid file name.<br/>
9988 2704 File does not exist.<br/>
9989 2705 Invalid option.<br/>
9990 2706 Invalid handle to the function.<br/>
9991 2707 Unknown table type.<br/>
9992 2708 Cannot open file.<br/>
9993 2709 Cannot redefine primary key.<br/>
9994 270A Cannot change this RINTDesc.<br/>
9995 270B Foreign and primary key do not match.<br/>
9996 270C Invalid modify request.<br/>
9997 270D Index does not exist.<br/>
9998 270E Invalid offset into the BLOB.<br/>
9999 270F Invalid descriptor number.<br/>
10000 2710 Invalid field type.<br/>
10001 2711 Invalid field descriptor.<br/>
10002 2712 Invalid field transformation.<br/>
10003 2713 Invalid record structure.<br/>
10004 2714 Invalid descriptor.<br/>
10005 2715 Invalid array of index descriptors.<br/>
10006 2716 Invalid array of validity check descriptors.<br/>
10007 2717 Invalid array of referential integrity descriptors.<br/>
10008 2718 Invalid ordering of tables during restructure.<br/>
10009 2719 Name not unique in this context.<br/>
10010 271A Index name required.<br/>
10011 271B Invalid session handle.<br/>
10012 271C invalid restructure operation.<br/>
10013 271D Driver not known to system.<br/>
10014 271E Unknown database.<br/>
10015 271F Invalid password given.<br/>
10016 2720 No callback function.<br/>
10017 2721 Invalid callback buffer length.<br/>
10018 2722 Invalid directory.<br/>
10019 2723 Translate Error. Value out of bounds.<br/>
10020 2724 Cannot set cursor of one table to another.<br/>
10021 2725 Bookmarks do not match table.<br/>
10022 2726 Invalid index/tag name.<br/>
10023 2727 Invalid index descriptor.<br/>
10024 2728 Table does not exist.<br/>
10025 2729 Table has too many users.<br/>
10026 272A Cannot evaluate Key or Key does not pass filter condition.<br/>
10027 272B Index already exists.<br/>
10028 272C Index is open.<br/>
10029 272D Invalid BLOB length.<br/>
10030 272E Invalid BLOB handle in record buffer.<br/>
10031 272F Table is open.<br/>
10032 2730 Need to do (hard) restructure.<br/>
10033 2731 Invalid mode.<br/>
10034 2732 Cannot close index.<br/>
10035 2733 Index is being used to order table.<br/>
10036 2734 Unknown user name or password.<br/>
10037 2735 Multi-level cascade is not supported.<br/>
10038 2736 Invalid field name.<br/>
10039 2737 Invalid table name.<br/>
10040 2738 Invalid linked cursor expression.<br/>
10041 2739 Name is reserved.<br/>
10042 273A Invalid file extension.<br/>
10043 273B Invalid language Driver.<br/>
10044 273C Alias is not currently opened.<br/>
10045 273D Incompatible record structures.<br/>
10046 273E Name is reserved by DOS.<br/>
10047 273F Destination must be indexed.<br/>
10048 2740 Invalid index type<br/>
10049 2741 Language Drivers of Table and Index do not match<br/>
10050 2742 Filter handle is invalid<br/>
10051 2743 Invalid Filter<br/>
10052 2744 Invalid table create request<br/>
10053 2745 Invalid table delete request<br/>
10054 2746 Invalid index create request<br/>
10055 2747 Invalid index delete request<br/>
10056 2748 Invalid table specified<br/>
10058 274A Invalid Time.<br/>
10059 274B Invalid Date.<br/>
10060 274C Invalid Datetime<br/>
10061 274D Tables in different directories<br/>
10062 274E Mismatch in the number of arguments<br/>
10063 274F Function not found in service library.<br/>
10064 2750 Must use baseorder for this operation.<br/>
10065 2751 Invalid procedure name<br/>
10241 2801 Record locked by another user.<br/>
10242 2802 Unlock failed.<br/>
10243 2803 Table is busy.<br/>
10244 2804 Directory is busy.<br/>
10245 2805 File is locked.<br/>
10246 2806 Directory is locked.<br/>
10247 2807 Record already locked by this session.<br/>
10248 2808 Object not locked.<br/>
10249 2809 Lock time out.<br/>
10250 280A Key group is locked.<br/>
10251 280B Table lock was lost.<br/>
10252 280C Exclusive access was lost.<br/>
10253 280D Table cannot be opened for exclusive use.<br/>
10254 280E Conflicting record lock in this session.<br/>
10255 280F A deadlock was detected.<br/>
10256 2810 A user transaction is already in progress.<br/>
10257 2811 No user transaction is currently in progress.<br/>
10258 2812 Record lock failed.<br/>
10259 2813 Couldn't perform the edit because another user changed the record.<br/>
10260 2814 Couldn't perform the edit because another user deleted or moved the record.<br/>
10497 2901 Insufficient field rights for operation.<br/>
10498 2902 Insufficient table rights for operation.Password required.<br/>
10499 2903 Insufficient family rights for operation.<br/>
10500 2904 This directory is read only.<br/>
10501 2905 Database is read only.<br/>
10502 2906 Trying to modify read-only field.<br/>
10503 2907 Encrypted dBASE tables not supported.<br/>
10504 2908 Insufficient SQL rights for operation.<br/>
10753 2A01 Field is not a BLOB.<br/>
10754 2A02 BLOB already opened.<br/>
10755 2A03 BLOB not opened.<br/>
10756 2A04 Operation not applicable.<br/>
10757 2A05 Table is not indexed.<br/>
10758 2A06 Engine not initialized.<br/>
10759 2A07 Attempt to re-initialize Engine.<br/>
10760 2A08 Attempt to mix objects from different sessions.<br/>
10761 2A09 Paradox driver not active.<br/>
10762 2A0A Driver not loaded.<br/>
10763 2A0B Table is read only.<br/>
10764 2A0C No associated index.<br/>
10765 2A0D Table(s) open. Cannot perform this operation.<br/>
10766 2A0E Table does not support this operation.<br/>
10767 2A0F Index is read only.<br/>
10768 2A10 Table does not support this operation because it is not uniquely indexed.<br/>
10769 2A11 Operation must be performed on the current session.<br/>
10770 2A12 Invalid use of keyword.<br/>
10771 2A13 Connection is in use by another statement.<br/>
10772 2A14 Passthrough SQL connection must be shared<br/>
11009 2B01 Invalid function number.<br/>
11010 2B02 File or directory does not exist.<br/>
11011 2B03 Path not found.<br/>
11012 2B04 Too many open files. You may need to increase MAXFILEHANDLE limit in IDAPI configuration.<br/>
11013 2B05 Permission denied.<br/>
11014 2B06 Bad file number.<br/>
11015 2B07 Memory blocks destroyed.<br/>
11016 2B08 Not enough memory.<br/>
11017 2B09 Invalid memory block address.<br/>
11018 2B0A Invalid environment.<br/>
11019 2B0B Invalid format.<br/>
11020 2B0C Invalid access code.<br/>
11021 2B0D Invalid data.<br/>
11023 2B0F Device does not exist.<br/>
11024 2B10 Attempt to remove current directory.<br/>
11025 2B11 Not same device.<br/>
11026 2B12 No more files.<br/>
11027 2B13 Invalid argument.<br/>
11028 2B14 Argument list is too long.<br/>
11029 2B15 Execution format error.<br/>
11030 2B16 Cross-device link.<br/>
11041 2B21 Math argument.<br/>
11042 2B22 Result is too large.<br/>
11043 2B23 File already exists.<br/>
11047 2B27 Unknown internal operating system error.<br/>
11058 2B32 Share violation.<br/>
11059 2B33 Lock violation.<br/>
11060 2B34 Critical DOS Error.<br/>
11061 2B35 Drive not ready.<br/>
11108 2B64 Not exact read/write.<br/>
11109 2B65 Operating system network error.<br/>
11110 2B66 Error from NOVELL file server.<br/>
11111 2B67 NOVELL server out of memory.<br/>
11112 2B68 Record already locked by this workstation.<br/>
11113 2B69 Record not locked.<br/>
11265 2C01 Network initialization failed.<br/>
11266 2C02 Network user limit exceeded.<br/>
11267 2C03 Wrong .NET file version.<br/>
11268 2C04 Cannot lock network file.<br/>
11269 2C05 Directory is not private.<br/>
11270 2C06 Multiple .NET files in use.<br/>
11271 2C07 Unknown network error.<br/>
11272 2C08 Not initialized for accessing network files.<br/>
11273 2C09 SHARE not loaded. It is required to share local files.<br/>
11274 2C0A Not on a network. Not logged in or wrong network driver.<br/>
11275 2C0B Lost communication with SQL server.<br/>
11521 2D01 Optional parameter is required.<br/>
11522 2D02 Invalid optional parameter.<br/>
11777 2E01 obsolete<br/>
11778 2E02 obsolete<br/>
11779 2E03 Ambiguous use of ! (inclusion operator).<br/>
11780 2E04 obsolete<br/>
11781 2E05 obsolete<br/>
11782 2E06 A SET operation cannot be included in its own grouping.<br/>
11783 2E07 Only numeric and date/time fields can be averaged.<br/>
11784 2E08 Invalid expression.<br/>
11785 2E09 Invalid OR expression.<br/>
11786 2E0A obsolete<br/>
11787 2E0B bitmap<br/>
11788 2E0C CALC expression cannot be used in INSERT, DELETE, CHANGETO and SET rows.<br/>
11789 2E0D Type error in CALC expression.<br/>
11790 2E0E CHANGETO can be used in only one query form at a time.<br/>
11791 2E0F Cannot modify CHANGED table.<br/>
11792 2E10 A field can contain only one CHANGETO expression.<br/>
11793 2E11 A field cannot contain more than one expression to be inserted.<br/>
11794 2E12 obsolete<br/>
11795 2E13 CHANGETO must be followed by the new value for the field.<br/>
11796 2E14 Checkmark or CALC expressions cannot be used in FIND queries.<br/>
11797 2E15 Cannot perform operation on CHANGED table together with a CHANGETO query.<br/>
11798 2E16 chunk<br/>
11799 2E17 More than 255 fields in ANSWER table.<br/>
11800 2E18 AS must be followed by the name for the field in the ANSWER table.<br/>
11801 2E19 DELETE can be used in only one query form at a time.<br/>
11802 2E1A Cannot perform operation on DELETED table together with a DELETE query.<br/>
11803 2E1B Cannot delete from the DELETED table.<br/>
11804 2E1C Example element is used in two fields with incompatible types or with a BLOB.<br/>
11805 2E1D Cannot use example elements in an OR expression.<br/>
11806 2E1E Expression in this field has the wrong type.<br/>
11807 2E1F Extra comma found.<br/>
11808 2E20 Extra OR found.<br/>
11809 2E21 One or more query rows do not contribute to the ANSWER.<br/>
11810 2E22 FIND can be used in only one query form at a time.<br/>
11811 2E23 FIND cannot be used with the ANSWER table.<br/>
11812 2E24 A row with GROUPBY must contain SET operations.<br/>
11813 2E25 GROUPBY can be used only in SET rows.<br/>
11814 2E26 Use only INSERT, DELETE, SET or FIND in leftmost column.<br/>
11815 2E27 Use only one INSERT, DELETE, SET or FIND per line.<br/>
11816 2E28 Syntax error in expression.<br/>
11817 2E29 INSERT can be used in only one query form at a time.<br/>
11818 2E2A Cannot perform operation on INSERTED table together with an INSERT query.<br/>
11819 2E2B INSERT, DELETE, CHANGETO and SET rows may not be checked.<br/>
11820 2E2C Field must contain an expression to insert (or be blank).<br/>
11821 2E2D Cannot insert into the INSERTED table.<br/>
11822 2E2E Variable is an array and cannot be accessed.<br/>
11823 2E2F Label<br/>
11824 2E30 Rows of example elements in CALC expression must be linked.<br/>
11825 2E31 Variable name is too long.<br/>
11826 2E32 Query may take a long time to process.<br/>
11827 2E33 Reserved word or one that can't be used as a variable name.<br/>
11828 2E34 Missing comma.<br/>
11829 2E35 Missing ).<br/>
11830 2E36 Missing right quote.<br/>
11831 2E37 Cannot specify duplicate column names.<br/>
11832 2E38 Query has no checked fields.<br/>
11833 2E39 Example element has no defining occurrence.<br/>
11834 2E3A No grouping is defined for SET operation.<br/>
11835 2E3B Query makes no sense.<br/>
11836 2E3C Cannot use patterns in this context.<br/>
11837 2E3D Date does not exist.<br/>
11838 2E3E Variable has not been assigned a value.<br/>
11839 2E3F Invalid use of example element in summary expression.<br/>
11840 2E40 Incomplete query statement. Query only contains a SET definition.<br/>
11841 2E41 Example element with ! makes no sense in expression.<br/>
11842 2E42 Example element cannot be used more than twice with a ! query.<br/>
11843 2E43 Row cannot contain expression.<br/>
11844 2E44 obsolete<br/>
11845 2E45 obsolete<br/>
11846 2E46 No permission to insert or delete records.<br/>
11847 2E47 No permission to modify field.<br/>
11848 2E48 Field not found in table.<br/>
11849 2E49 Expecting a column separator in table header.<br/>
11850 2E4A Expecting a column separator in table.<br/>
11851 2E4B Expecting column name in table.<br/>
11852 2E4C Expecting table name.<br/>
11853 2E4D Expecting consistent number of columns in all rows of table.<br/>
11854 2E4E Cannot open table.<br/>
11855 2E4F Field appears more than once in table.<br/>
11856 2E50 This DELETE, CHANGE or INSERT query has no ANSWER.<br/>
11857 2E51 Query is not prepared. Properties unknown.<br/>
11858 2E52 DELETE rows cannot contain quantifier expression.<br/>
11859 2E53 Invalid expression in INSERT row.<br/>
11860 2E54 Invalid expression in INSERT row.<br/>
11861 2E55 Invalid expression in SET definition.<br/>
11862 2E56 row use<br/>
11863 2E57 SET keyword expected.<br/>
11864 2E58 Ambiguous use of example element.<br/>
11865 2E59 obsolete<br/>
11866 2E5A obsolete<br/>
11867 2E5B Only numeric fields can be summed.<br/>
11868 2E5C Table is write protected.<br/>
11869 2E5D Token not found.<br/>
11870 2E5E Cannot use example element with ! more than once in a single row.<br/>
11871 2E5F Type mismatch in expression.<br/>
11872 2E60 Query appears to ask two unrelated questions.<br/>
11873 2E61 Unused SET row.<br/>
11874 2E62 INSERT, DELETE, FIND, and SET can be used only in the leftmost column.<br/>
11875 2E63 CHANGETO cannot be used with INSERT, DELETE, SET or FIND.<br/>
11876 2E64 Expression must be followed by an example element defined in a SET.<br/>
11877 2E65 Lock failure.<br/>
11878 2E66 Expression is too long.<br/>
11879 2E67 Refresh exception during query.<br/>
11880 2E68 Query canceled.<br/>
11881 2E69 Unexpected Database Engine error.<br/>
11882 2E6A Not enough memory to finish operation.<br/>
11883 2E6B Unexpected exception.<br/>
11884 2E6C Feature not implemented yet in query.<br/>
11885 2E6D Query format is not supported.<br/>
11886 2E6E Query string is empty.<br/>
11887 2E6F Attempted to prepare an empty query.<br/>
11888 2E70 Buffer too small to contain query string.<br/>
11889 2E71 Query was not previously parsed or prepared.<br/>
11890 2E72 Function called with bad query handle.<br/>
11891 2E73 QBE syntax error.<br/>
11892 2E74 Query extended syntax field count error.<br/>
11893 2E75 Field name in sort or field clause not found.<br/>
11894 2E76 Table name in sort or field clause not found.<br/>
11895 2E77 Operation is not supported on BLOB fields.<br/>
11896 2E78 General BLOB error.<br/>
11897 2E79 Query must be restarted.<br/>
11898 2E7A Unknown answer table type.<br/>
11926 2E96 Blob cannot be used as grouping field.<br/>
11927 2E97 Query properties have not been fetched.<br/>
11928 2E98 Answer table is of unsuitable type.<br/>
11929 2E99 Answer table is not yet supported under server alias.<br/>
11930 2E9A Non-null blob field required. Can't insert records<br/>
11931 2E9B Unique index required to perform changeto<br/>
11932 2E9C Unique index required to delete records<br/>
11933 2E9D Update of table on the server failed.<br/>
11934 2E9E Can't process this query remotely.<br/>
11935 2E9F Unexpected end of command.<br/>
11936 2EA0 Parameter not set in query string.<br/>
11937 2EA1 Query string is too long.<br/>
12033 2F01 Interface mismatch. Engine version different.<br/>
12034 2F02 Index is out of date.<br/>
12035 2F03 Older version (see context).<br/>
12036 2F04 .VAL file is out of date.<br/>
12037 2F05 BLOB file version is too old.<br/>
12038 2F06 Query and Engine DLLs are mismatched.<br/>
12289 3001 Capability not supported.<br/>
12290 3002 Not implemented yet.<br/>
12291 3003 SQL replicas not supported.<br/>
12292 3004 Non-blob column in table required to perform operation.<br/>
12293 3005 Multiple connections not supported.<br/>
12545 3101 Invalid database alias specification.<br/>
12546 3102 Unknown database type.<br/>
12547 3103 Corrupt system configuration file.<br/>
12548 3104 Network type unknown.<br/>
12549 3105 Not on the network.<br/>
12550 3106 Invalid configuration parameter.<br/>
12801 3201 Object implicitly dropped.<br/>
12802 3202 Object may be truncated.<br/>
12803 3203 Object implicitly modified.<br/>
12804 3204 Should field constraints be checked?<br/>
12805 3205 Validity check field modified.<br/>
12806 3206 Table level changed.<br/>
12807 3207 Copy linked tables?<br/>
12809 3209 Object implicitly truncated.<br/>
12810 320A Validity check will not be enforced.<br/>
12811 320B Multiple records found, but only one was expected.<br/>
12812 320C Field will be trimmed, cannot put master records into PROBLEM table.<br/>
13057 3301 File already exists.<br/>
13058 3302 BLOB has been modified.<br/>
13059 3303 General SQL error.<br/>
13060 3304 Table already exists.<br/>
13061 3305 Paradox 1.0 tables are not supported.<br/>
13313 3401 Different sort order.<br/>
13314 3402 Directory in use by earlier version of Paradox.<br/>
13315 3403 Needs Paradox 3.5-compatible language driver.<br/>
14849 3A01 SYSTEM<br/>
14850 3A02 DRIVERS<br/>
14851 3A03 DATABASES<br/>
14853 3A05 VERSION<br/>
14854 3A06 NET TYPE<br/>
14855 3A07 NET DIR<br/>
14856 3A08 LOCAL SHARE<br/>
14857 3A09 LANGDRIVER<br/>
14858 3A0A LANGDRVDIR<br/>
14859 3A0B MINBUFSIZE<br/>
14860 3A0C MAXBUFSIZE<br/>
14861 3A0D LOCKRETRY<br/>
14862 3A0E SYSFLAGS<br/>
14863 3A0F MAXFILEHANDLES<br/>
14864 3A10 SQLQRYMODE<br/>
14865 3A11 LOW MEMORY USAGE LIMIT<br/>
14866 3A12 AUTO ODBC<br/>
14867 3A13 DEFAULT DRIVER<br/>
14868 3A14 VERSION<br/>
14869 3A15 TYPE<br/>
14870 3A16 LANGDRIVER<br/>
14871 3A17 FILL FACTOR<br/>
14872 3A18 BLOCK SIZE<br/>
14873 3A19 LOCKPROTOCOL<br/>
14874 3A1A LEVEL<br/>
14875 3A1B DRIVER FLAGS<br/>
14878 3A1E MEMO FILE BLOCK SIZE<br/>
14879 3A1F MDX BLOCK SIZE<br/>
14888 3A28 INIT<br/>
14889 3A29 DB CREATE<br/>
14890 3A2A DB OPEN<br/>
14891 3A2B TABLE CREATE<br/>
14892 3A2C TABLE OPEN<br/>
14898 3A32 DB INFO<br/>
14908 3A3C TYPE<br/>
14909 3A3D PATH<br/>
14910 3A3E DEFAULT DRIVER<br/>
14918 3A46 INIT<br/>
14919 3A47 TYPE<br/>
14920 3A48 STANDARD<br/>
14921 3A49 TRUE<br/>
14922 3A4A FALSE<br/>
14923 3A4B OPEN MODE<br/>
14924 3A4C READ/WRITE<br/>
14925 3A4D READ ONLY<br/>
14926 3A4E SHARE MODE<br/>
14927 3A4F EXCLUSIVE<br/>
14928 3A50 SHARED<br/>
14929 3A51 USER NAME<br/>
14930 3A52 SERVER NAME<br/>
14931 3A53 DATABASE NAME<br/>
14932 3A54 SCHEMA CACHE SIZE<br/>
14933 3A55 STRICTINTEGRTY<br/>
14938 3A5A ORACLE<br/>
14939 3A5B 1.0<br/>
14940 3A5C SERVER<br/>
14941 3A5D NET PROTOCOL<br/>
14942 3A5E DECNET<br/>
14943 3A5F NETBIOS<br/>
14944 3A60 NAMED PIPES<br/>
14945 3A61 SPX/IPX<br/>
14946 3A62 TCP/IP<br/>
14947 3A63 3270<br/>
14948 3A64 VINES<br/>
14949 3A65 APPC<br/>
14950 3A66 ASYNC<br/>
14958 3A6E SYBASE<br/>
14959 3A6F 1.0<br/>
14960 3A70 SERVER<br/>
14961 3A71 BLOB EDIT LOGGING<br/>
14962 3A72 CONNECT TIMEOUT<br/>
14963 3A73 TIMEOUT<br/>
14964 3A74 DATE MODE<br/>
14965 3A75 DATE SEPARATOR<br/>
14966 3A76 DECIMAL SEPARATOR<br/>
14968 3A78 INTRBASE<br/>
14969 3A79 1.0<br/>
14970 3A7A SERVER<br/>
14978 3A82 FORMATS<br/>
14979 3A83 DATE<br/>
14980 3A84 TIME<br/>
14981 3A85 NUMBER<br/>
14988 3A8C SEPARATOR<br/>
14989 3A8D MODE<br/>
14990 3A8E FOURDIGITYEAR<br/>
14991 3A8F YEARBIASED<br/>
14992 3A90 LEADINGZEROM<br/>
14993 3A91 LEADINGZEROD<br/>
14994 3A92 TWELVEHOUR<br/>
14995 3A93 AMSTRING<br/>
14996 3A94 PMSTRING<br/>
14997 3A95 SECONDS<br/>
14998 3A96 MILSECONDS<br/>
15008 3AA0 DECIMALSEPARATOR<br/>
15009 3AA1 THOUSANDSEPARATOR<br/>
15010 3AA2 DECIMALDIGITS<br/>
15011 3AA3 LEADINGZERON<br/>
15013 3AA5 ascii<br/>
15014 3AA6 DB437US0<br/>
15018 3AAA /<br/>
15019 3AAB 0<br/>
15020 3AAC FALSE<br/>
15021 3AAD TRUE<br/>
15022 3AAE TRUE<br/>
15023 3AAF TRUE<br/>
15024 3AB0 TRUE<br/>
15025 3AB1 AM<br/>
15026 3AB2 PM<br/>
15027 3AB3 TRUE<br/>
15028 3AB4 FALSE<br/>
15029 3AB5 .<br/>
15030 3AB6 ,<br/>
15031 3AB7 TRUE<br/>
15873 3E01 Wrong driver name.<br/>
15874 3E02 Wrong system version.<br/>
15875 3E03 Wrong driver version.<br/>
15876 3E04 Wrong driver type.<br/>
15877 3E05 Cannot load driver.<br/>
15878 3E06 Cannot load language driver.<br/>
15879 3E07 Vendor initialization failed.<br/>
16129 3F01 Query By Example<br/>
16130 3F02 SQL Generator<br/>
16131 3F03 IDAPI<br/>
16132 3F04 Lock Manager<br/>
16133 3F05 SQL Driver<br/>
16134 3F06 IDAPI Services<br/>
16135 3F07 dBASE Driver<br/>
16138 3F0A Token<br/>
16140 3F0C Table<br/>
16141 3F0D Field<br/>
16142 3F0E Image<br/>
16143 3F0F User<br/>
16144 3F10 File<br/>
16145 3F11 Index<br/>
16146 3F12 Directory<br/>
16147 3F13 Key<br/>
16148 3F14 Alias<br/>
16149 3F15 Drive<br/>
16150 3F16 Server error<br/>
16151 3F17 Server message<br/>
16152 3F18 Line Number<br/>
16153 3F19 Capability<br/>
16154 3F1A Limit<br/>
16239 3F6F WORK<br/>
16240 3F70 PRIV<br/>
16241 3F71 Rec
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-26783634172881604242011-06-04T15:00:00.001-07:002011-06-25T03:32:08.383-07:00List Template In Delphi
<br/>
Problem/Question/Abstract:<br/>
<br/>
How to create a type specific list in Delphi without reimplementing the entired list for each type ?<br/>
<br/>
Answer:<br/>
<br/>
The C++ language has a nice feature, that's called Templates. It allowes the programer to define a class (or a method) that acts with a none-specific type. At complie time, the programer describes for which type the class will be defined. That is, you can define a general list (list template) and define all of it's methods to work on type A (where 'A' is not defined). For example, the method GetItem will look as follows : <br/>
<br/>
function GetItem(Index: Integer): A;<br/>
<br/>
Then, at compile type you tell the complier that 'A' is actually an Integer, and the complier replaces all of the accurances of 'A' with 'Integer'. That way, you can write one list (for type 'A'), and each time you wan a list (of Strings, Integers, Boolean, Soubles, etc.) you just need to tell the complier to replace 'A' with the type you want. <br/>
<br/>
All of that is very nice, but has nothing to do with Delphi. It's relevent only to C++ programers. So what do Delphi programers do ? <br/>
<br/>
There are 3 majore options. First, write a list of pointers once, and then use it many times by passing to it a pointer to the datatype you are interested in. For Example : <br/>
<br/>
TList = class<br/>
...<br/>
public<br/>
procedure Add(Value: Pointer);<br/>
<br/>
function GetItem(Index: Integer): Pointer;<br/>
procedure SetItem(Index: Integer; Value: Pointer);<br/>
<br/>
property Items[Index: Integer]: Pointer read GetItem write SetItem;<br/>
<br/>
end;<br/>
<br/>
Here is the code to use this : <br/>
<br/>
// For Integer;<br/>
type<br/>
PInteger = ^Integer;<br/>
var<br/>
Item: PInteger;<br/>
List: TList;<br/>
begin<br/>
List := TList.Create;<br/>
GetMem(Item, SizeOf(Item));<br/>
Item^ := 1023; // Or what ever value you wish<br/>
List.Add(Item);<br/>
ShowMessage(IntToStr(PInteger(List.Items[0])^));<br/>
end;<br/>
<br/>
// For Double;<br/>
type<br/>
PDouble = ^Double;<br/>
var<br/>
Item: PDouble;<br/>
List: TList;<br/>
begin<br/>
List := TList.Create;<br/>
GetMem(Item, SizeOf(Item));<br/>
Item^ := 3.14.15926; // Or what ever value you wish<br/>
List.Add(Item);<br/>
ShowMessage(FloatToStr(PDouble(List.Items[0])^));<br/>
end;<br/>
<br/>
As you've probably noticed there are a few drawbacks to this solution. The most obvious one is that you need to typecast the value returned by the List each time you want to use it. That might seem as a mere inconvinouce, but if you plan to uses lists intensivly, you'll get REALY tired of typecasting all the time. The second problem to consider with this design is memory concerns. In the example above, I've allocated memory to Item, but never free it. That's because the TList class I've used doesn't allocate memory by itself. But then arisses the question, how will free the memory ? Probably the TList itself (since the item is now 'owned' by it), but that is a bit unconventional, because usually the object (or method) that allocates the memory is responsibly to freeing it. You can solve this by writing the TList class so it allocates it's own memory and only COPIES the value pointed to by Item. But then there are two other problem. <br/>
<br/>
You need to free the memory of Item after adding it to the List (since the List isn't going to free it - it only copied the Items contents). <br/>
You need to find a way of telling TList how many byte to copy. Since TList gets a pointer and doesn't know what it points to (a string ? an integer ? a double ?), it has no way of knowing how many bytes to copy. <br/>
<br/>
Those are all very good reasons why NOT to use this solution. Lets have a look at the second solution out of the three. <br/>
<br/>
The second solution is very simple. Write a new list for each type. That is, write a TIntergerList, TStringList, TDoubleList, TWhatEverList. Example : <br/>
<br/>
TIntegerList = class<br/>
...<br/>
public<br/>
procedure Add(Value: Integer);<br/>
<br/>
function GetItem(Index: Integer): Integer;<br/>
procedure SetItem(Index: Integer; Value: Integer);<br/>
<br/>
proepry Items[Idnex: Integer]: Integer read GetItem write SetItem;<br/>
end;<br/>
<br/>
TDoubleList = class<br/>
...<br/>
public<br/>
procedure Add(Value: Double);<br/>
<br/>
function GetItem(Index: Integer): Double;<br/>
procedure SetItem(Index: Integer; Value: Double);<br/>
<br/>
property Items[Index: Integer]: Double read GetItem write SetItem;<br/>
end;<br/>
<br/>
The benefits are obvious. You can use a list and have no memory problems and you need not typecast ! Implementing these lists could be a little time consuming, but if you work a lot with the same types of lists it might be worth while. The only draw back of this design (except for a one time developing cost) is it's not extendable (at least not easly). That is, if you want to add a new function to your List (for example : SaveToFile), you'll have to add the same code for each list you implement. That vrings us to the third and final solution. <br/>
<br/>
This solution is a combination of the first and second solutions. It tries to take the best of each. The first solution was very general (worked for every type without adding code), but you couldn't make it specific (you have to use typecasting inorder to use an Item). The second solution was very specific (no typecasting needed) but you had to write a bunch of code for each new list you wanted to implement. <br/>
<br/>
And here is the third solution : Define a base class that is the same as the TList in the first solution. Then, for each new list you want (for example : TIntegerList) smiply inherite from the base class and add the type specific methods (for example : procedure Add(Value : Integer)). There are a few problems with this design as well, but I'll discuss them later. For now, lets see why this design helps as more than the other two. <br/>
<br/>
First, it allows you to use type specific lists (no need for typecasting). Second it doesn't require you to write a lot of code (five mintues will do) for each new List because most of the methods are already implemented and the new methods that need to be implemented are very short. <br/>
<br/>
Lets look closly at the last suggestion. First we need to define a base class : <br/>
<br/>
TBaseList = class<br/>
protected<br/>
procedure AddData(Value: Pointer);<br/>
class function ItemSize: Integer; virtual; abstract;<br/>
end;<br/>
<br/>
procedure TBaseLink.AddData(Value: Pointer);<br/>
var<br/>
P: Pointer;<br/>
begin<br/>
GetMem(P, ItemSize);<br/>
Move(P^, Value^, ItemSize);<br/>
// Here you need to add P to your list.<br/>
// The way that is done may vary by the way you decide<br/>
// to save your data. You may want to save it as an Array<br/>
// or as a linked list, or as a tree, or into a stream, etc.<br/>
end;<br/>
<br/>
Now, lets create a TIntegerList : <br/>
<br/>
TIntegerList = class<br/>
protected<br/>
class function ItemSize: Integer; override;<br/>
public<br/>
procedure Add(Value: Integer);<br/>
end;<br/>
<br/>
class fucntion TIntegerList.ItemSize: Integer;<br/>
begin<br/>
Result := SizeOf(Integer);<br/>
end;<br/>
<br/>
procedure TIntegerList.Add(Value: Integer);<br/>
var<br/>
P: ^Integer;<br/>
begin<br/>
GetMem(P, SizeOf(Integer));<br/>
try<br/>
P^ := Value;<br/>
AddData(P);<br/>
finally<br/>
FreeMem(P, SizeOf(Integer));<br/>
end;<br/>
end;<br/>
<br/>
This example is simplefied. In a real list (with full capabilitys) most of the coding is in the base class, and only a few methods are need to be implemented in the derived classes. <br/>
<br/>
I've attached a full implementation of this concept for TIntegerList and TStringList. Notice a few things about the attached file : a) The IBooleanList is defined but not implemented. b) The marked out methods at the begining of the file are not implemented yet. c) Objects aren't suported yet. <br/>
<br/>
When I finish coding these lists, I'll write another article describing my specific implementation of this idea. <br/>
<br/>
Component Download: http://www.kastu.lt/dkb/downfile/download.php?id=100
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-41647915483641335262011-06-03T15:00:00.001-07:002011-06-25T03:32:10.617-07:00BDE API Overview
<br/>
Problem/Question/Abstract:<br/>
<br/>
BDE API Overview<br/>
<br/>
Answer:<br/>
<br/>
Available BDE 4.0 engine functions by type:<br/>
<br/>
<br/>
<br/>
1. Database functions<br/>
<br/>
Each function listed below returns information about a specific database, available databases, or performs a database-related task, such as opening or closing a database.<br/>
<br/>
<br/>
<br/>
DbiCloseDatabase:<br/>
Closes a database and all tables associated with this database handle.<br/>
<br/>
DbiGetDatabaseDesc:<br/>
Retrieves the description of the specified database from the configuration file.<br/>
<br/>
DbiGetDirectory:<br/>
Retrieves the current working directory or the default directory.<br/>
<br/>
DbiOpenDatabase:<br/>
Opens a database in the current session and returns a database handle.<br/>
<br/>
DbiOpenDatabaseList:<br/>
Creates an in-memory table containing a list of accessible databases and their descriptions.<br/>
<br/>
DbiOpenFileList:<br/>
Opens a cursor on the virtual table containing all the tables accessible by the client application<br/>
and their descriptions.<br/>
<br/>
DbiOpenIndexList:<br/>
Opens a cursor on an in-memory table listing the indexes on a specified table, along with<br/>
their descriptions.<br/>
<br/>
DbiOpenTableList:<br/>
Creates an in-memory table with information about all the tables accessible to the client application.<br/>
<br/>
<br/>
<br/>
<br/>
2. Environment and configuration functions<br/>
<br/>
Each function listed below returns information about the client application environment, such as the supported table, field and index types for the driver type, or the available driver types. Functions in this category can also perform tasks that affect the client application environment, such as loading a driver.<br/>
<br/>
<br/>
<br/>
DbiAddAlias:<br/>
Adds an alias to the BDE configuration file (IDAPI.CFG).<br/>
<br/>
DbiAddDriver:<br/>
Adds a driver to the BDE configuration file (IDAPI.CFG). NEW FUNCTION BDE 4.0<br/>
<br/>
DbiAnsiToNative:<br/>
Multipurpose translate function.<br/>
<br/>
DbiDebugLayerOptions:<br/>
Activates, deactivates, or sets options for the BDE debug layer. OBSOLETE FUNCTION BDE 4.0<br/>
<br/>
DbiDeleteAlias:<br/>
Deletes an alias from the BDE configuration file (IDAPI.CFG).<br/>
<br/>
DbiDeleteDriver:<br/>
Deletes a driver from the BDE configuration file (IDAPI.CFG). NEW FUNCTION BDE 4.0<br/>
<br/>
DbiDllExit:<br/>
Prepares the BDE to be disconnected within a DLL. NEW FUNCTION BDE 4.0<br/>
<br/>
DbiExit:<br/>
Disconnects the client application from BDE.<br/>
<br/>
DbiGetClientInfo:<br/>
Retrieves system-level information about the client application environment.<br/>
<br/>
DbiGetDriverDesc:<br/>
Retrieves a description of a driver.<br/>
<br/>
DbiGetLdName:<br/>
Retrieves the name of the language driver associated with the specified object name (table name).<br/>
<br/>
DbiGetLdObj:<br/>
Retrieves the language driver object associated with the given cursor.<br/>
<br/>
DbiGetNetUserName:<br/>
Retrieves the user's network login name. User names should be available for all networks<br/>
supported by Microsoft Windows.<br/>
<br/>
DbiGetProp:<br/>
Returns a property of an object.<br/>
<br/>
DbiGetSysConfig:<br/>
Retrieves BDE system configuration information.<br/>
<br/>
DbiGetSysInfo:<br/>
Retrieves system status and information.<br/>
<br/>
DbiGetSysVersion:<br/>
Retrieves the system version information, including the BDE version number, date, and time,<br/>
and the client interface version number.<br/>
<br/>
DbiInit:<br/>
Initializes the BDE environment.<br/>
<br/>
DbiLoadDriver:<br/>
Load a given driver.<br/>
<br/>
DbiNativeToAnsi:<br/>
Translates a string in the native language driver to an ANSI string.<br/>
<br/>
DbiOpenCfgInfoList:<br/>
Returns a handle to an in-memory table listing all the nodes in the configuration file<br/>
accessible by the specified path.<br/>
<br/>
DbiOpenDriverList:<br/>
Creates an in-memory table containing a list of driver names available to the client application.<br/>
<br/>
DbiOpenFieldTypesList:<br/>
Creates an in-memory table containing a list of field types supported by the table type for<br/>
the driver type.<br/>
<br/>
DbiOpenFunctionArgList:<br/>
Returns a list of arguments to a data source function.<br/>
<br/>
DbiOpenFunctionList:<br/>
Returns a description of a data source function.<br/>
<br/>
DbiOpenIndexTypesList:<br/>
Creates an in-memory table containing a list of all supported index types for the driver type.<br/>
<br/>
DbiOpenLdList:<br/>
Creates an in-memory table containing a list of available language drivers.<br/>
<br/>
DbiOpenTableList:<br/>
Creates an in-memory table with information about all the tables accessible to the client application.<br/>
<br/>
DbiOpenTableTypesList:<br/>
Creates an in-memory table listing table type names for the given driver.<br/>
<br/>
DbiOpenUserList:<br/>
Creates an in-memory table containing a list of users sharing the same network file.<br/>
<br/>
DbiSetProp:<br/>
Sets the specified property of an object to a given value.<br/>
<br/>
DbiUseIdleTime:<br/>
Allows BDE to accomplish background tasks during times when the client application is idle.<br/>
OBSOLETE FUNCTION BDE 4.0<br/>
<br/>
<br/>
<br/>
<br/>
3. Session functions<br/>
<br/>
Each function listed below returns information about a session or performs a task that affects the session, such as starting a session or adding a password.<br/>
<br/>
<br/>
<br/>
DbiAddPassword:<br/>
Adds a password to the current session.<br/>
<br/>
DbiCheckRefresh:<br/>
Checks for remote updates to tables for all cursors in the current session, and refreshes the cursors<br/>
if changed.<br/>
<br/>
DbiCloseSession:<br/>
Closes the session associated with the given session handle.<br/>
<br/>
DbiDropPassword:<br/>
Removes a password from the current session.<br/>
<br/>
DbiGetCallBack:<br/>
Returns a pointer to the function previously registered by the client for the given callback type.<br/>
<br/>
DbiGetCurrSession:<br/>
Returns the handle associated with the current session.<br/>
<br/>
DbiGetDateFormat:<br/>
Gets the date format for the current session.<br/>
<br/>
DbiGetNumberFormat:<br/>
Gets the number format for the current session.<br/>
<br/>
DbiGetSesInfo:<br/>
Retrieves the environment settings for the current session.<br/>
<br/>
DbiGetTimeFormat:<br/>
Gets the time format for the current session.<br/>
<br/>
DbiRegisterCallBack:<br/>
Registers a callback function for the client application.<br/>
<br/>
DbiSetCurrSession:<br/>
Sets the current session of the client application to the session associated with hSes.<br/>
<br/>
DbiSetDateFormat:<br/>
Sets the date format for the current session.<br/>
<br/>
DbiSetNumberFormat:<br/>
Sets the number format for the current session.<br/>
<br/>
DbiSetPrivateDir:<br/>
Sets the private directory for the current session.<br/>
<br/>
DbiSetTimeFormat:<br/>
Sets the time format for the current session.<br/>
<br/>
DbiStartSession:<br/>
Starts a new session for the client application.<br/>
<br/>
<br/>
<br/>
<br/>
4. Error-handling functions<br/>
<br/>
Each function listed below returns error handling information or performs a task that relates to error handling.<br/>
<br/>
<br/>
<br/>
DbiGetErrorContext:<br/>
After receiving an error code back from a call, enables the client to probe BDE for more specific<br/>
error information.<br/>
<br/>
DbiGetErrorEntry:<br/>
Returns the error description of a specified error stack entry.<br/>
<br/>
DbiGetErrorInfo:<br/>
Provides descriptive error information about the last error that occurred.<br/>
<br/>
DbiGetErrorString:<br/>
Returns the message associated with a given error code.<br/>
<br/>
<br/>
<br/>
<br/>
5. Lock functions<br/>
<br/>
Each function listed below returns information about lock status or acquires or releases a lock at the table or record level.<br/>
<br/>
<br/>
<br/>
DbiAcqPersistTableLock:<br/>
Acquires an exclusive persistent lock on the table preventing other users from using the table<br/>
or creating a table of the same name.<br/>
<br/>
DbiAcqTableLock:<br/>
Acquires a table-level lock on the table associated with the given cursor.<br/>
<br/>
DbiGetRecord:<br/>
Record positioning functions have a lock parameter.<br/>
<br/>
DbiIsRecordLocked:<br/>
Checks the lock status of the current record.<br/>
<br/>
DbiIsTableLocked:<br/>
Returns the number of locks of a specified type acquired on the table associated with the<br/>
given session.<br/>
<br/>
DbiIsTableShared:<br/>
Determines whether the table is physically shared or not.<br/>
<br/>
DbiOpenLockList:<br/>
Creates an in-memory table containing a list of locks acquired on the table.<br/>
<br/>
DbiOpenUserList:<br/>
Creates an in-memory table containing a list of users sharing the same network file.<br/>
<br/>
DbiRelPersistTableLock:<br/>
Releases the persistent table lock on the specified table.<br/>
<br/>
DbiRelRecordLock:<br/>
Releases the record lock on either the current record of the cursor or only the locks acquired<br/>
in the current session.<br/>
<br/>
DbiRelTableLock:<br/>
Releases table locks of the specified type associated with the current session (the session in<br/>
which the cursor was created).<br/>
<br/>
DbiSetLockRetry:<br/>
Sets the table and record lock retry time for the current session.<br/>
<br/>
<br/>
<br/>
<br/>
6. Cursor functions<br/>
<br/>
Each function listed below returns information about a cursor, or performs a task that performs a cursor-related task such as positioning of a cursor, linking of cursors, creating and closing cursors, counting of records associated with a cursor, filtering, setting and comparing bookmarks, and refreshing all buffers associated with a cursor.<br/>
<br/>
<br/>
<br/>
DbiActivateFilter:<br/>
Activates a filter.<br/>
<br/>
DbiAddFilter:<br/>
Adds a filter to a table, but does not activate the filter (the record set is not yet altered).<br/>
<br/>
DbiApplyDelayedUpdates:<br/>
When cached updates cursor layer is active, writes all modifications made to cached data to the<br/>
underlying database.<br/>
<br/>
DbiBeginDelayedUpdates:<br/>
Creates a cached updates cursor layer so that users can make extended changes to temporarily<br/>
cached table data without writing to the actual table, thereby minimizing resource locking.<br/>
<br/>
DbiBeginLinkMode:<br/>
Converts a cursor to a link cursor. Given an open cursor, prepares for linked access. Returns a<br/>
new cursor.<br/>
<br/>
DbiCloneCursor:<br/>
Creates a new cursor (clone cursor) which has the same result set as the given cursor<br/>
(source cursor).<br/>
<br/>
DbiCloseCursor:<br/>
Closes a previously opened cursor.<br/>
<br/>
DbiCompareBookMarks:<br/>
Compares the relative positions of two bookmarks in the result set associated with the cursor.<br/>
<br/>
DbiDeactivateFilter:<br/>
Temporarily stops the specified filter from affecting the record set by turning the filter off.<br/>
<br/>
DbiDropFilter:<br/>
Deactivates and removes a filter from memory, and frees all resources.<br/>
<br/>
DbiEndDelayedUpdates:<br/>
Closes a cached updates cursor layer ending the cached updates mode.<br/>
<br/>
DbiEndLinkMode:<br/>
Ends linked cursor mode, and returns the original cursor.<br/>
<br/>
DbiExtractKey:<br/>
Retrieves the key value for the current record of the given cursor or from the supplied record buffer.<br/>
<br/>
DbiForceRecordReread:<br/>
Rereads a single record from the server on demand, refreshing one row only, rather than clearing<br/>
the cache.<br/>
<br/>
DbiForceReread:<br/>
Refreshes all buffers associated with the cursor, if necessary.<br/>
<br/>
DbiFormFullName:<br/>
Returns the fully qualified table name.<br/>
<br/>
DbiGetBookMark:<br/>
Saves the current position of a cursor to the client-supplied buffer called a bookmark.<br/>
<br/>
DbiGetCursorForTable:<br/>
Finds the cursor for the given table.<br/>
<br/>
DbiGetCursorProps:<br/>
Returns the properties of the cursor.<br/>
<br/>
DbiGetExactRecordCount:<br/>
Retrieves the current exact number of records associated with the cursor. NEW FUNCTION BDE 4.0<br/>
<br/>
DbiGetFieldDescs:<br/>
Retrieves a list of descriptors for all the fields in the table associated with the cursor.<br/>
<br/>
DbiGetLinkStatus:<br/>
Returns the link status of the cursor.<br/>
<br/>
DbiGetNextRecord:<br/>
Retrieves the next record in the table associated with the cursor.<br/>
<br/>
DbiGetPriorRecord:<br/>
Retrieves the previous record in the table associated with the given cursor.<br/>
<br/>
DbiGetProp:<br/>
Returns a property of an object.<br/>
<br/>
DbiGetRecord:<br/>
Retrieves the current record, if any, in the table associated with the cursor.<br/>
<br/>
DbiGetRecordCount:<br/>
Retrieves the current number of records associated with the cursor.<br/>
<br/>
DbiGetRecordForKey:<br/>
Finds and retrieves a record matching a key and positions the cursor on that record.<br/>
<br/>
DbiGetRelativeRecord:<br/>
Positions the cursor on a record in the table relative to the current position of the cursor.<br/>
<br/>
DbiGetSeqNo:<br/>
Retrieves the sequence number of the current record in the table associated with the cursor.<br/>
<br/>
DbiLinkDetail:<br/>
Establishes a link between two tables such that the detail table has its record set limited to the<br/>
set of records matching the linking key values of the master table cursor.<br/>
<br/>
DbiLinkDetailToExp:<br/>
Links the detail cursor to the master cursor using an expression.<br/>
<br/>
DbiMakePermanent:<br/>
Changes a temporary table created by DbiCreateTempTable into a permanent table.<br/>
<br/>
DbiOpenTable:<br/>
Opens the given table for access and associates a cursor handle with the opened table.<br/>
<br/>
DbiResetRange:<br/>
Removes the specified table's limited range previously established by the function DbiSetRange.<br/>
<br/>
DbiSaveChanges:<br/>
Forces all updated records associated with the cursor to disk.<br/>
<br/>
DbiSetFieldMap:<br/>
Sets a field map of the table associated with the given cursor.<br/>
<br/>
DbiSetProp:<br/>
Sets the specified property of an object to a given value.<br/>
<br/>
DbiSetRange:<br/>
Sets a range on the result set associated with the cursor.<br/>
<br/>
DbiSetToBegin:<br/>
Positions the cursor to BOF (just before the first record).<br/>
<br/>
DbiSetToBookMark:<br/>
Positions the cursor to the location saved in the specified bookmark.<br/>
<br/>
DbiSetToCursor:<br/>
Sets the position of one cursor (the destination cursor) to that of another (the source cursor).<br/>
<br/>
DbiSetToEnd:<br/>
Positions the cursor to EOF (just after the last record).<br/>
<br/>
DbiSetToKey:<br/>
Positions an index-based cursor on a key value.<br/>
<br/>
DbiSetToRecordNo:<br/>
Positions the cursor of a dBASE table to the given physical record number.<br/>
<br/>
DbiSetToSeqNo:<br/>
Positions the cursor to the specified sequence number of a Paradox table.<br/>
<br/>
DbiUnlinkDetail:<br/>
Removes a link between two cursors.<br/>
<br/>
<br/>
<br/>
<br/>
7. Index functions<br/>
<br/>
Each function listed below returns information about an index or indexes, or performs a task that affects an index, such as dropping it, deleting it, or adding it.<br/>
<br/>
<br/>
<br/>
DbiAddIndex:<br/>
Creates an index on an existing table.<br/>
<br/>
DbiCloseIndex:<br/>
Closes the specified index on a cursor.<br/>
<br/>
DbiCompareKeys:<br/>
Compares two key values based on the current index of the cursor.<br/>
<br/>
DbiDeleteIndex:<br/>
Drops an index on a table.<br/>
<br/>
DbiExtractKey:<br/>
Retrieves the key value for the current record of the given cursor or from the supplied record buffer.<br/>
<br/>
DbiGetIndexDesc:<br/>
Retrieves the properties of the given index associated with the cursor.<br/>
<br/>
DbiGetIndexDescs:<br/>
Retrieves index properties.<br/>
<br/>
DbiGetIndexForField:<br/>
Returns the description of any useful index on the specified field.<br/>
<br/>
DbiGetIndexSeqNo:<br/>
Retrieves the ordinal number of the index in the index list of the specified cursor.<br/>
<br/>
DbiGetIndexTypeDesc:<br/>
Retrieves a description of the index type.<br/>
<br/>
DbiOpenIndex:<br/>
Opens the index for the table associated with the cursor.<br/>
<br/>
DbiRegenIndex:<br/>
Regenerates an index to make sure that it is up-to-date (all records currently in the table<br/>
are included in the index and are in the index order).<br/>
<br/>
DbiRegenIndexes:<br/>
Regenerates all out-of-date indexes on a given table.<br/>
<br/>
DbiSwitchToIndex:<br/>
Allows the user to change the active index order of the given cursor.<br/>
<br/>
<br/>
<br/>
<br/>
8. Query functions<br/>
<br/>
Each function listed below performs a query task, such as preparing and executing a SQL or QBE query.<br/>
<br/>
<br/>
<br/>
DbiGetProp:<br/>
Returns a property of an object.<br/>
<br/>
DbiQAlloc:<br/>
Allocates a new statement handle for a prepared query.<br/>
<br/>
DbiQExec:<br/>
Executes the previously prepared query identified by the supplied statement handle and<br/>
returns a cursor to the result set, if one is generated.<br/>
<br/>
DbiQExecDirect:<br/>
Executes a SQL or QBE query and returns a cursor to the result set, if one is generated.<br/>
<br/>
DbiQExecProcDirect:<br/>
Executes a stored procedure and returns a cursor to the result set, if one is generated.<br/>
<br/>
DbiQFree:<br/>
Frees the resources associated with a previously prepared query identified by the supplied<br/>
statement handle.<br/>
<br/>
DbiQGetBaseDescs:<br/>
Returns the original database, table, and field names of the fields that make up the result<br/>
set of a query.<br/>
<br/>
DbiQInstantiateAnswer:<br/>
Creates a permanent table from the cursor to the result set.<br/>
<br/>
DbiQPrepare:<br/>
Prepares a SQL or QBE query for execution, and returns a handle to a statement containing<br/>
the prepared query.<br/>
<br/>
DbiQPrepareProc:<br/>
Prepares and optionally binds parameters for a stored procedure.<br/>
<br/>
DbiQSetParams:<br/>
Associates data with parameter markers embedded within a prepared query.<br/>
<br/>
DbiQSetProcParams:<br/>
Binds parameters for a stored procedure prepared with DbiQPrepareProc.<br/>
<br/>
DbiSetProp:<br/>
Sets the specified property of an object to a given value.<br/>
<br/>
DbiValidateProp:<br/>
Validates a property.<br/>
<br/>
<br/>
<br/>
<br/>
9. Table functions<br/>
<br/>
Each function listed below returns information about a specific table, such as all the locks acquired on the table, all the referential integrity links on the table, the indexes open on the table, or whether or not the table is shared. Functions in this category can also perform a table-wide operation, such as copying and deleting.<br/>
<br/>
<br/>
<br/>
DbiBatchMove:<br/>
Appends, updates, subtracts, and copies records or fields from a source table to a destination table.<br/>
<br/>
DbiCopyTable:<br/>
Duplicates the specified source table to a destination table.<br/>
<br/>
DbiCreateInMemTable:<br/>
Creates a temporary, in-memory table.<br/>
<br/>
DbiCreateTable:<br/>
Creates a table.<br/>
<br/>
DbiCreateTempTable:<br/>
Creates a temporary table that is deleted when the cursor is closed, unless the call is followed<br/>
by a call to DbiMakePermanent.<br/>
<br/>
DbiDeleteTable:<br/>
Deletes a table.<br/>
<br/>
DbiDoRestructure:<br/>
Changes the properties of a table.<br/>
<br/>
DbiEmptyTable:<br/>
Deletes all records from the table associated with the specified table cursor handle or table name.<br/>
<br/>
DbiGetTableOpenCount:<br/>
Returns the total number of cursors that are open on the specified table.<br/>
<br/>
DbiGetTableTypeDesc:<br/>
Returns a description of the capabilities of the table type for the driver type.<br/>
<br/>
DbiIsTableLocked:<br/>
Returns the number of locks of a specified type acquired on the table associated with the<br/>
given session.<br/>
<br/>
DbiIsTableShared:<br/>
Determines whether the table is physically shared or not.<br/>
<br/>
DbiMakePermanent:<br/>
Changes a temporary table created by DbiCreateTempTable into a permanent table.<br/>
<br/>
DbiOpenFamilyList:<br/>
Creates an in-memory table listing the family members associated with a specified table.<br/>
<br/>
DbiOpenFieldList:<br/>
Creates an in-memory table listing the fields in a specified table and their descriptions.<br/>
<br/>
DbiOpenIndexList:<br/>
Opens a cursor on an in-memory table listing the indexes on a specified table, along with<br/>
their descriptions.<br/>
<br/>
DbiOpenLockList:<br/>
Creates an in-memory table containing a list of locks acquired on the table associated with the cursor.<br/>
<br/>
DbiOpenRintList:<br/>
Creates an in-memory table listing the referential integrity links for a specified table, along with<br/>
their descriptions.<br/>
<br/>
DbiOpenSecurityList:<br/>
Creates an in-memory table listing record-level security information about a specified table.<br/>
<br/>
DbiOpenTable:<br/>
Opens the given table for access and associates a cursor handle with the opened table.<br/>
<br/>
DbiPackTable:<br/>
Optimizes table space by rebuilding the table associated with the cursor and releasing any free space.<br/>
<br/>
DbiQInstantiateAnswer:<br/>
Creates a permanent table from a cursor handle.<br/>
<br/>
DbiRegenIndexes:<br/>
Regenerates all out-of-date indexes on a given table.<br/>
<br/>
DbiRenameTable:<br/>
Renames the table and all of its resources to the new name specified.<br/>
<br/>
DbiSaveChanges:<br/>
Forces all updated records associated with the table to disk.<br/>
<br/>
DbiSortTable:<br/>
Sorts an opened or closed table, either into itself or into a destination table. There are options to<br/>
remove duplicates, to enable case-insensitive sorts and special sort functions, and to control the<br/>
number of records sorted.<br/>
<br/>
<br/>
<br/>
<br/>
10. Data access functions<br/>
<br/>
Each function listed below accesses data in a table, such as retrieving data from a specified BLOB field or from the record buffer.<br/>
<br/>
<br/>
<br/>
DbiAppendRecord:<br/>
Appends a record to the end of the table associated with the given cursor.<br/>
<br/>
DbiDeleteRecord:<br/>
Deletes the current record of the given cursor.<br/>
<br/>
DbiFreeBlob:<br/>
Closes the BLOB handle located within the specified record buffer.<br/>
<br/>
DbiGetBlob:<br/>
Retrieves data from the specified BLOB field.<br/>
<br/>
DbiGetBlobHeading:<br/>
Retrieves information about a BLOB field from the BLOB heading in the record buffer.<br/>
<br/>
DbiGetBlobSize:<br/>
Retrieves the size of the specified BLOB field in bytes.<br/>
<br/>
DbiGetField:<br/>
Retrieves the data contents of the requested field from the record buffer.<br/>
<br/>
DbiGetFieldDescs:<br/>
Retrieves a list of descriptors for all the fields in the table associated with the cursor.<br/>
<br/>
DbiGetFieldTypeDesc:<br/>
Retrieves a description of the specified field type.<br/>
<br/>
DbiInitRecord:<br/>
Initializes the record buffer to a blank record according to the data types of the fields.<br/>
<br/>
DbiInsertRecord:<br/>
Inserts a new record into the table associated with the given cursor.<br/>
<br/>
DbiModifyRecord:<br/>
Modifies the current record of table associated with the cursor with the data supplied.<br/>
<br/>
DbiOpenBlob:<br/>
Prepares the cursor's record buffer to access a BLOB field.<br/>
<br/>
DbiPutBlob:<br/>
Writes data into an open BLOB field.<br/>
<br/>
DbiPutField:<br/>
Writes the field value to the correct location in the supplied record buffer.<br/>
<br/>
DbiReadBlock:<br/>
Reads a specified number of records (starting from the next position of the cursor) into a buffer.<br/>
<br/>
DbiSaveChanges:<br/>
Forces all updated records associated with the cursor to disk.<br/>
<br/>
DbiSetFieldMap:<br/>
Sets a field map of the table associated with the given cursor.<br/>
<br/>
DbiTruncateBlob:<br/>
Shortens the size of the contents of a BLOB field, or deletes the contents of a BLOB field<br/>
from the record, by shortening it to zero.<br/>
<br/>
DbiUndeleteRecord:<br/>
Undeletes a dBASE record that has been marked for deletion (a "soft" delete).<br/>
<br/>
DbiVerifyField:<br/>
Verifies that the data specified is a valid data type for the field specified, and that all validity<br/>
checks in place for the field are satisfied. It can also be used to check if a field is blank.<br/>
<br/>
DbiWriteBlock:<br/>
Writes a block of records to the table associated with the cursor.<br/>
<br/>
<br/>
<br/>
<br/>
11. Transaction functions<br/>
<br/>
Each function listed below begins, ends, or inquires about the status of a transaction.<br/>
<br/>
<br/>
<br/>
DbiBeginTran:<br/>
Begins a transaction.<br/>
<br/>
DbiEndTran:<br/>
Ends a transaction.<br/>
<br/>
DbiGetTranInfo:<br/>
Retrieves the transaction state.<br/>
<br/>
<br/>
<br/>
<br/>
12. Capability or schema functions<br/>
<br/>
Each function listed below returns information about capabilities or the schema.<br/>
<br/>
<br/>
<br/>
DbiOpenCfgInfoList:<br/>
Returns a handle to an in-memory table listing all the nodes in the configuration file accessible by<br/>
the specified path.<br/>
<br/>
DbiOpenDatabaseList:<br/>
Creates an in-memory table containing a list of accessible databases and their descriptions.<br/>
<br/>
DbiOpenDriverList:<br/>
Creates an in-memory table containing a list of driver names available to the client application.<br/>
<br/>
DbiOpenFamilyList:<br/>
Creates an in-memory table listing the family members associated with a specified table.<br/>
<br/>
DbiOpenFieldList:<br/>
Creates an in-memory table listing the fields in a specified table and their descriptions.<br/>
<br/>
DbiOpenFieldTypesList:<br/>
Creates an in-memory table containing a list of field types supported by the table type for the driver type.<br/>
<br/>
DbiOpenFunctionArgList:<br/>
Returns a list of arguments to a data source function.<br/>
<br/>
DbiOpenFunctionList:<br/>
Returns a description of a data source function.<br/>
<br/>
DbiOpenIndexList:<br/>
Opens a cursor on an in-memory table listing the indexes on a specified table, along with<br/>
their descriptions.<br/>
<br/>
DbiOpenIndexTypesList:<br/>
Creates an in-memory table containing a list of all supported index types for the driver type.<br/>
<br/>
DbiOpenLockList:<br/>
Creates an in-memory table containing a list of locks acquired on the table.<br/>
<br/>
DbiOpenRintList :<br/>
Creates an in-memory table listing the referential integrity links for a specified table, along with<br/>
their descriptions.<br/>
<br/>
DbiOpenSecurityList:<br/>
Creates an in-memory table listing record-level security information about a specified table.<br/>
<br/>
DbiOpenTableList:<br/>
Creates an in-memory table with information about all the tables accessible to the client application.<br/>
<br/>
DbiOpenTableTypesList:<br/>
Creates an in-memory table listing table type names for the given driver.<br/>
<br/>
DbiOpenVchkList:<br/>
Creates an in-memory table containing records with information about validity checks for fields<br/>
within the specified table.<br/>
<br/>
<br/>
<br/>
<br/>
13. Date/time/number format functions<br/>
<br/>
Each function listed below sets or retrieves date or time, or decodes/encodes date and time into or from a timestamp.<br/>
<br/>
<br/>
<br/>
DbiBcdFromFloat:<br/>
Converts FLOAT data to binary coded decimal (BCD) format.<br/>
<br/>
DbiBcdToFloat:<br/>
Converts binary coded decimal (BCD) data to FLOAT format.<br/>
<br/>
DbiDateDecode:<br/>
Decodes DBIDATE into separate month, day and year components.<br/>
<br/>
DbiDateEncode:<br/>
Encodes separate date components into date for use by DbiPutField and other functions.<br/>
<br/>
DbiGetDateFormat:<br/>
Gets the date format for the current session.<br/>
<br/>
DbiGetNumberFormat:<br/>
Gets the number format for the current session.<br/>
<br/>
DbiGetTimeFormat:<br/>
Gets the time format for the current session.<br/>
<br/>
DbiSetDateFormat:<br/>
Sets the date format for the current session.<br/>
<br/>
DbiSetNumberFormat:<br/>
Sets the number format for the current session.<br/>
<br/>
DbiSetTimeFormat:<br/>
Sets the time format for the current session.<br/>
<br/>
DbiTimeDecode:<br/>
Decodes time into separate components (hours, minutes, milliseconds).<br/>
<br/>
DbiTimeEncode:<br/>
Encodes separate time components into time for use by DbiPutField and other functions.<br/>
<br/>
DbiTimeStampDecode:<br/>
Extracts separate encoded date and time components from the timestamp.<br/>
<br/>
DbiTimeStampEncode:<br/>
Encodes the encoded date and encoded time into a timestamp.
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-91531784654233663112011-06-02T15:00:00.000-07:002011-06-25T03:32:12.085-07:00Align cells in a TStringGrid (4)
<br/>
Problem/Question/Abstract:<br/>
<br/>
Anyone know a simple way of vertically centering your text in a TStringGrid cell. Actually, I wish the StringGrid had the ability to align horizontally as well.<br/>
<br/>
Answer:<br/>
<br/>
Below is some Delphi3 code that I wrote for handling left-right alignment of text in string grids. It would be straightforward to change it for vertical instead (or as well). See DT_BOTTOM, DT_VCENTER and DT_TOP in the description of DrawText in Delphi's Win32 help file. The code also handles automatic word-wrapping and font changes on a per cell basis.<br/>
<br/>
procedure DrawSGCell(Sender: TObject; C, R: integer; Rect: TRect;<br/>
Style: TFontStyles; Wrap: boolean; Just: TAlignment; NoEditCols: TNoEditCols);<br/>
<br/>
{formats cell text; call this routine from grid's DrawCell event;<br/>
Style is TFontStyles...<br/>
TFontStyles = set of TFontStyle;<br/>
TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);<br/>
Wrap is word-wrap on/off,<br/>
Just is (taLeftJustify, taRightJustify, taCenter)}<br/>
<br/>
var<br/>
S: string;<br/>
DrawRect: TRect;<br/>
begin<br/>
{multi-line wordwrapped cells, with any justification, and any font params}<br/>
{if Row > 0 then<br/>
{ only used for column headings}<br/>
exit;<br/>
}<br/>
{ get cell contents }<br/>
with (Sender as TStringGrid), Canvas do<br/>
begin<br/>
S := Cells[C, R];<br/>
{erase earlier contents from default drawing }<br/>
Brush.Color := FixedColor;<br/>
if (R >= FixedRows) and (C >= FixedCols) and not (C in NoEditCols) then<br/>
Brush.Color := Color;<br/>
FillRect(Rect);<br/>
if length(S) > 0 then<br/>
begin<br/>
{switch to font style}<br/>
Font.Style := Style;<br/>
{local copy of cell rectangle}<br/>
DrawRect := Rect;<br/>
if Wrap then<br/>
begin<br/>
{get size of text rectangle in DrawRect}<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_calcrect or dt_wordbreak or<br/>
dt_center);<br/>
if (DrawRect.Bottom - DrawRect.Top) > RowHeights[R] then<br/>
begin<br/>
{cell word-wrapped; need to increase row height}<br/>
RowHeights[R] := DrawRect.Bottom - DrawRect.Top;<br/>
SetGridHeight(Sender as TStringGrid);<br/>
end<br/>
else<br/>
begin<br/>
DrawRect.Right := Rect.Right;<br/>
FillRect(DrawRect);<br/>
case Just of<br/>
taLeftJustify:<br/>
begin<br/>
S := ' ' + S;<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_wordbreak or<br/>
dt_left);<br/>
end;<br/>
taCenter:<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_wordbreak or<br/>
dt_center);<br/>
taRightJustify:<br/>
begin<br/>
S := S + ' ';<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_wordbreak or<br/>
dt_right);<br/>
end;<br/>
end;<br/>
end;<br/>
end<br/>
else<br/>
{no wrap}<br/>
case Just of<br/>
taLeftJustify:<br/>
begin<br/>
S := ' ' + S;<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_singleline or<br/>
dt_vcenter or dt_left);<br/>
end;<br/>
taCenter:<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_singleline or<br/>
dt_vcenter or dt_center);<br/>
taRightJustify:<br/>
begin<br/>
S := S + ' ';<br/>
DrawText(Handle, PChar(S), length(S), DrawRect, dt_singleline or<br/>
dt_vcenter or dt_right);<br/>
end;<br/>
end;<br/>
{restore no font styles}<br/>
Font.Style := [];<br/>
end;<br/>
end;<br/>
end;
Unknownnoreply@blogger.com0tag:blogger.com,1999:blog-5232582584575965466.post-48030490161203943522011-06-01T15:00:00.000-07:002011-06-25T03:32:13.026-07:00Simple Thread Example
<br/>
Problem/Question/Abstract:<br/>
<br/>
This article will show you how to create Threads and show you how to work with global variables within a Thread. You need the unit SyncObjs (part of Delphi Enterprise) for this sample.<br/>
<br/>
Answer:<br/>
<br/>
As mentioned in the Abstract, you will need the unit SyncObjs. This unit, however, is a Delphi Enterprise feature. In another article I will show you how to work around this problem, however, until then you may search the web for workarounds. There are some available already. <br/>
<br/>
THREADS <br/>
<br/>
Threads will allow you to open up one or more additional processes within your application. This allows you to process different tasks parallel. Usually your Delphi applications will accomplish one task after another. <br/>
<br/>
Operationg systems like Windows NT or Windows 2000, however, support multi-tasking, allowing multiple processes to work at virtualyl the same time. Within you applications you can make use of these feature by using threads. This will come in handy in different cases like multiple-processor machines or if one task has to wait for something else (e.q. disk access). A single threaded application (e.q. your normal Delphi app) will have to wait until every task is accomplished before running the next one - mutli-threaded apps work them parallel. <br/>
<br/>
WHEN TO USE THREADS <br/>
<br/>
Either you want to support multi-processor machines or you know your tasks depend on other tasks and not only on your calculations. <br/>
<br/>
Especially on single processor machines the use of threads may actually degrade the performance of your whole application. If some task(s) have to be accomplished before the application can continue and all of these tasks are rather demanding for the processor you may consider not to use threading. However, on a multi-processor machine you will, almost certainly, gain speed using threading. <br/>
<br/>
You should use threading when: <br/>
<br/>
multiple, independent tasks need to be accomplished <br/>
your application runs on multi-processor systems <br/>
the accomplished tasks run idle some of their working time <br/>
you want to learn working with Threads :) <br/>
<br/>
PROBLEMS WITH THREADS <br/>
<br/>
Using Threads can open little "trouble cans." In single-threaded apps you have control over the execution order of your tasks and the way they access global variables. In multi-threaded applications you do not have this kind of control anymore, because multiple threads can access the variable at the same time. Reading global variables out of a thread will, usually, not create problems. Writing, itself, is no problem either. However, reading a variable, working with it and writing the new value back to the variable, will certainly bring you in trouble if two threads do this at the same time. <br/>
<br/>
NOTE: For all of you how "hate" global variables, I do too. However, in threaded applications you will often have to use them in order to exchange processing informations. <br/>
<br/>
CRITICAL SECTIONS <br/>
<br/>
The problem mentioned before is the "critical section" of your thread. Once you decide to access a global variable, work with it, change its value and write it back you have to ensure that no other thread will do the same with this variable at the same time. Windows offers CriticalSections as a mean of thread control. Only one thread at a time can be within the critical section. Therefore, only one thread at a time can manipulate the value of the variables. <br/>
<br/>
Critical Sections are not depending on their position in the code. You can use on Critical Section for different areas of your application. A critical section is a specific variable that holds references for every thread accessing in, allowing only one thread at a time to pass through it. Therefore, a thread should only use critical sections where needed and release it as soon as possible. Additionally, you have to ensure that the thread will leave the critical section or no other thread will be able to enter it - your application will not continue processing any data. <br/>
<br/>
Pseudo-Code without a CS <br/>
Pseudo-Code with a CS<br/>
-<br/>
-<br/>
Load global variable<br/>
-<br/>
Work with gl. var. <br/>
-<br/>
Save global variable <br/>
-<br/>
-<br/>
-<br/>
Enter CS <br/>
try <br/>
Load global variable<br/>
-<br/>
Work with gl. var.<br/>
-<br/>
Save global variable <br/>
finally<br/>
Leave CS<br/>
end <br/>
<br/>
<br/>
<br/>
NOTE: The use of critical sections will, slightly, slow down you application because of the processing (Enter/Leave) of the critical section as well as the fact that only one process can be within the code area of the critical section. <br/>
<br/>
ENOUGH THEORY - A SAMPLE <br/>
<br/>
The following sample will not be "great," it will be simple to show you the facts addressed before. The use of the variables isn't the best, however, do not mind - it just simple to learn. <br/>
<br/>
THE FORM <br/>
<br/>
Create a new application. Name the Form frmMain. To the form add an SpinEdit (sedtThreadCnt) from the Samples page. There we can choose how many threads will be started from our application. Add a Check Box (chkCS) allowing the user to choose whether the thread-safe (with a critical section) model is used or not. Add a Label (lblResult) to show the final Result of our Threads and a Button (btnStart) allowing the us to start the Thread Test. For the Form add an OnCreate and an OnDestroy, for the Button an OnClick event using the Object Inspector. <br/>
<br/>
The code snippet below shows the full declaration of the form. Adapt the private and the public section. <br/>
<br/>
NOTE: Add the unit "SyncObjs" to your global uses clause - it is needed for the TCriticalSection class. <br/>
<br/>
TfrmMain = class(TForm)<br/>
Label1: TLabel;<br/>
sedtThreadCnt: TSpinEdit;<br/>
btnStart: TButton;<br/>
lblResult: TLabel;<br/>
chkCS: TCheckBox;<br/>
procedure btnStartClick(Sender: TObject);<br/>
procedure FormCreate(Sender: TObject);<br/>
procedure FormDestroy(Sender: TObject);<br/>
private<br/>
{ Private declarations }<br/>
FThreadCount: Integer;<br/>
FCriticalSection: TCriticalSection;<br/>
FGlobalVariable: Integer;<br/>
procedure ThreadDone(Sender: TObject);<br/>
procedure SetGlobalVariable(const Value: Integer);<br/>
public<br/>
{ Public declarations }<br/>
property GlobalVariable: Integer<br/>
read FGlobalVariable<br/>
write SetGlobalVariable;<br/>
property CriticalSection: TCriticalSection<br/>
read FCriticalSection;<br/>
end;<br/>
<br/>
THE THREAD CLASSES <br/>
<br/>
The following code snippet shows the declarations of both the unsafe and the safe version. Besides the class names they ar identical. <br/>
<br/>
Every running Thread will increment a global variable 1000 times by one. Therefore, after running exactly one thread the global variable should be 1000, after 2 threads 2000, after 3 threads 3000, and so on ... or ? Well depending on the use of the critical section - one thread model will return the result as expected the other will not... <br/>
<br/>
TUnsafeSampleThread = class(TThread)<br/>
private<br/>
FLocalVariable: Integer;<br/>
protected<br/>
public<br/>
procedure Execute; override;<br/>
end;<br/>
<br/>
TSafeSampleThread = class(TThread)<br/>
private<br/>
FLocalVariable: Integer;<br/>
protected<br/>
public<br/>
procedure Execute; override;<br/>
end;<br/>
<br/>
THE FULL SOURCE CODE <br/>
<br/>
Below you can see the full source code. One, not nice part, is the Execute part of both Thread versions. You will see quite often the line: <br/>
<br/>
Application.ProcessMessages;<br/>
<br/>
I had to add this line in order to allow the other threads to execute as well. Our way of adding "idle time" to the threads. <br/>
<br/>
RUNNING THE APPLICATION <br/>
<br/>
The application will allow you to choose the number of threads running concurrently and whether to use the safe version or not. Have fun... <br/>
<br/>
unit uMainForm;<br/>
<br/>
interface<br/>
<br/>
uses<br/>
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br/>
StdCtrls, Spin, SyncObjs;<br/>
<br/>
type<br/>
TUnsafeSampleThread = class(TThread)<br/>
private<br/>
FLocalVariable: Integer;<br/>
protected<br/>
public<br/>
procedure Execute; override;<br/>
end;<br/>
<br/>
TSafeSampleThread = class(TThread)<br/>
private<br/>
FLocalVariable: Integer;<br/>
protected<br/>
public<br/>
procedure Execute; override;<br/>
end;<br/>
<br/>
TfrmMain = class(TForm)<br/>
Label1: TLabel;<br/>
sedtThreadCnt: TSpinEdit;<br/>
btnStart: TButton;<br/>
lblResult: TLabel;<br/>
chkCS: TCheckBox;<br/>
procedure btnStartClick(Sender: TObject);<br/>
procedure FormCreate(Sender: TObject);<br/>
procedure FormDestroy(Sender: TObject);<br/>
private<br/>
{ Private declarations }<br/>
FThreadCount: Integer;<br/>
FCriticalSection: TCriticalSection;<br/>
FGlobalVariable: Integer;<br/>
procedure ThreadDone(Sender: TObject);<br/>
procedure SetGlobalVariable(const Value: Integer);<br/>
public<br/>
{ Public declarations }<br/>
property GlobalVariable: Integer<br/>
read FGlobalVariable<br/>
write SetGlobalVariable;<br/>
property CriticalSection: TCriticalSection<br/>
read FCriticalSection;<br/>
end;<br/>
<br/>
var<br/>
frmMain: TfrmMain;<br/>
<br/>
implementation<br/>
<br/>
{$R *.DFM}<br/>
<br/>
{ TUnsafeSampleThread }<br/>
<br/>
procedure TUnsafeSampleThread.Execute;<br/>
var<br/>
I: Integer;<br/>
begin<br/>
for I := 1 to 1000 do<br/>
begin<br/>
Application.ProcessMessages;<br/>
FLocalVariable := frmMain.GlobalVariable;<br/>
Application.ProcessMessages;<br/>
Inc(FLocalVariable);<br/>
Application.ProcessMessages;<br/>
frmMain.GlobalVariable := FLocalVariable;<br/>
end;<br/>
end;<br/>
<br/>
{ TSafeSampleThread }<br/>
<br/>
procedure TSafeSampleThread.Execute;<br/>
var<br/>
I: Integer;<br/>
begin<br/>
for I := 1 to 1000 do<br/>
begin<br/>
Application.ProcessMessages;<br/>
frmMain.CriticalSection.Acquire;<br/>
try<br/>
FLocalVariable := frmMain.GlobalVariable;<br/>
Application.ProcessMessages;<br/>
Inc(FLocalVariable);<br/>
Application.ProcessMessages;<br/>
frmMain.GlobalVariable := FLocalVariable;<br/>
finally<br/>
frmMain.CriticalSection.Release;<br/>
end;<br/>
end;<br/>
end;<br/>
<br/>
{ TfrmMain }<br/>
<br/>
procedure TfrmMain.ThreadDone(Sender: TObject);<br/>
begin<br/>
Dec(FThreadCount);<br/>
if FThreadCount = 0 then<br/>
begin<br/>
btnStart.Enabled := True;<br/>
lblResult.Caption := 'GlobalVariable: ' + IntToStr(GlobalVariable);<br/>
end;<br/>
end;<br/>
<br/>
procedure TfrmMain.btnStartClick(Sender: TObject);<br/>
var<br/>
I: Integer;<br/>
begin<br/>
GlobalVariable := 0;<br/>
FThreadCount := sedtThreadCnt.Value;<br/>
for I := 0 to FThreadCount - 1 do<br/>
if chkCS.Checked then<br/>
with TSafeSampleThread.Create(False) do<br/>
OnTerminate := ThreadDone<br/>
else<br/>
with TUnsafeSampleThread.Create(False) do<br/>
OnTerminate := ThreadDone;<br/>
btnStart.Enabled := False;<br/>
end;<br/>
<br/>
procedure TfrmMain.SetGlobalVariable(const Value: Integer);<br/>
begin<br/>
FGlobalVariable := Value;<br/>
end;<br/>
<br/>
procedure TfrmMain.FormCreate(Sender: TObject);<br/>
begin<br/>
FCriticalSection := TCriticalSection.Create;<br/>
end;<br/>
<br/>
procedure TfrmMain.FormDestroy(Sender: TObject);<br/>
begin<br/>
FCriticalSection.Free;<br/>
end;<br/>
<br/>
end.
Unknownnoreply@blogger.com3