2011. június 24., péntek
Using SOAP with Delphi
Problem/Question/Abstract:
Using SOAP with Delphi
Answer:
Introduction
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.
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… Well, that area is definitely full of details.
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.
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.
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.
SOAP?
However, what is SOAP? Should you use it and if so, how can you use it today?
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
There's nothing really complex or unique about SOAP, except maybe its simplicity.
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.
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
Luckily for us, As soon as Delphi 6 will be released, we will have much more to play with.
A practical example
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).
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.
The example demonstrates how to get a stock quote from a web server using SOAP.
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.
The instructions on how to install the example are contained in the file Readme.txt
The example
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:
function GetQuote(const Symbol: WideString): Double
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.
This is the sequence of events that occurs after the user presses the “Get Quote" button:
The TSOAPClient asks the web server for an XML file that describes the interface of the SOAP server.
The web server returns a standard Web Services Description Language (WSDL) file.
The client is now ready to invoke any method on the server and prepares the a GetQuote message which then sends to the server
The web sever grabs the message and passes it to the SOAPServer COM object
The SOAPServer object reads the SOAP message and invokes the GetQuote method of our test COM object
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
The client finally displays the result
Demystifying SOAP – Client side
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.
When you press the “Get Quote" button in the client application the following code is executed:
procedure TMainForm.bGetQuoteClick(Sender: TObject);
var
quote: currency;
begin
// Retrieves the WSDL information only the first time…
if SOAPClient.Connected or SOAPClient.Connect then
begin
// Invokes the GetQuote method
quote := SOAPClient.Client.GetQuote(eSticker.Text);
// Displays the result
ShowMessage(eSticker.Text + ' is worth ' + FloatToStr(quote) + '$');
end;
end;
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.
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:
<?xml version='1.0' encoding='UTF-8' ?>
<definitions name ='StockQuote' targetNamespace = 'http://tempuri.org/wsdl/'
xmlns:wsdlns='http://tempuri.org/wsdl/'
xmlns:typens='http://tempuri.org/type'
xmlns:soap='http://schemas.xmlsoap.org/wsdl/soap/'
xmlns:xsd='http://www.w3.org/2001/XMLSchema'
xmlns:stk='http://schemas.microsoft.com/soap-toolkit/wsdl-extension'
xmlns='http://schemas.xmlsoap.org/wsdl/'>
<types>
<schema targetNamespace='http://tempuri.org/type'
xmlns='http://www.w3.org/2001/XMLSchema'
xmlns:SOAP-ENC='http://schemas.xmlsoap.org/soap/encoding/'
xmlns:wsdl='http://schemas.xmlsoap.org/wsdl/'
elementFormDefault='qualified'>
</schema>
</types>
<message name='StockQuote.GetQuote'>
<part name='Symbol' type='xsd:string'/>
</message>
<message name='StockQuote.GetQuoteResponse'>
<part name='Result' type='xsd:double'/>
</message>
[..]
<service name='StockQuote' >
<port name='StockQuoteSoapPort' binding='wsdlns:StockQuoteSoapBinding' >
<soap:address location='http://localhost/SOAP/StockQuote.ASP' />
</port>
</service>
[..]
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 “Symbol" and returns a floating point.
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.
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.
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
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:
function SOAPInvoke(aMethodName: string; someParameters: array of OleVariant):
OleVariant;
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.
The server
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.
The SOAP Message that is received in this particular case is:
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<m:GetQuote xmlns:m="http://tempuri.org/message/">
<Symbol>BORL</Symbol>
</m:GetQuote>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
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.
This instead, is part of the ASP file StockQuote.asp that illustrates what's happening on the server side:
<%@ LANGUAGE=VBScript %>
<% Response.ContentType = "text/xml"%>
<%
[..]
Set SoapServer = Server.CreateObject("MSSOAP.SoapServer")
SoapServer.Init WSDLFilePath, WSMLFilePath
SoapServer.SoapInvoke Request, Response, ""
[..]
%>
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.
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.
The following diagram illustrates this:
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.
This is how a successful result would look in our previous example:
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<m:GetQuoteResponse xmlns:m="http://tempuri.org/message/">
<Result>100</Result>
</m:GetQuoteResponse>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
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:
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<SOAP-ENV:Envelope SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/">
<SOAP-ENV:Body>
<SOAP-ENV:Fault>
<faultcode>SOAP-ENV:Server</faultcode>
<faultstring>WSDLOperation: Executing method GetQuote failed</faultstring>
<faultactor>http://tempuri.org/action/StockQuote.GetQuote</faultactor>
<detail>
[..]
<mserror:description>A symbol must be specified</mserror:description>
[..]
</detail>
</SOAP-ENV:Fault>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>
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.
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.
Pros and cons
As any technology, SOAP comes with its sets of pros and cons.
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.
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.
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 .
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.
XML and the SOAP convention for packaging messages add a lot of extra overhead.
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.
Conclusion
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.
Its simplicity and the fact that is quickly becoming a standard are key factors.
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.
Resources
If you want to know more about SOAP, the following resources may be very helpful:
The SOAP specification (version 1.1) is located at http://www.w3.org/TR/2000/NOTE-SOAP-20000508/
The Microsoft SOAP SDKs and other interesting articles can be found at http://www.msdn.microsoft.com/xml/default.asp
The Java based IBM Web Services Toolkit runtime environment can be found at http://www.alphaworks.ibm.com/tech/webs ervicestoolkit
The book “Understanding SOAP" written by Scrinber and Stiver and published by Sams is a great and detailed source of information on this topic.
Special thanks
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.
2011. június 20., hétfő
MySQL and Delphi
Problem/Question/Abstract:
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.
Answer:
This is based on the Open source MySQL connector "Objects".
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.
First also need a copy of the actual connector objects. Which can be found at:
http://sourceforge.net/projects/directsql/
http://prdownloads.sourceforge.net/directsql/DirectMysqlObjects.zip?download
If your interested there is also a demo which shows off its capabilities which can be found:
http://prdownloads.sourceforge.net/directsql/DemoObjectsWin.zip?download
To use the MySQL objects - simply unzip the contents of the zip you just downloaded into {Delphi}/lib/ folder.
Now to use them all you need to do is add a couple of things to the uses of your interface:
uMySqlVio, uMysqlCT, uMysqlClient, uMysqlHelpers
Its as easy as that!
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.
Connection Example
First add "MySQLClient: TMySQLClient;" to your main form's public. This will make the actual client that you'll do all the work with.
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.
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):
MySQLClient := TMySQLClient.Create;
Next add the following to the OnDestroy procedure:
MySQLClient.Free;
if MySQLResult <> nil then
MySQLResult.Free;
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.
Add 5 edit boxes to your form and 3 check boxes. For quick reference label (leave the names the same) them
Edit1 - Host
Edit2 - Port
Edit3 - User
Edit4 - Password
Edit5 - Db
Check1 - Use named pipes
Check2 - Use SSL
Check3 - Compress
Now add the following code to your OnClick procedure for the connect button you added earlier:
MySQLClient.Host := Edit1.Text;
MySQLClient.port := StrToInt(Edit2.text);
MySQLClient.user := Edit3.text;
MySQLClient.password := Edit4.text;
MySQLClient.Db := Edit5.Text;
MySQLClient.UseNamedPipe := CheckBox1.Checked;
MySQLClient.UseSSL := CheckBox2.Checked;
MySQLClient.Compress := CheckBox3.Checked;
if MySQLClient.Connect then ShowMessage('connected ok!')
else ShowMessage('Somthing went wrong!");
Or instead of the big chunk of text you can use:
if FMysql.Connect(Edit1.Text, Edit3.Text, Edit4.Text, 'db', StrToInt(Edit2.text), '', false, 0) then ShowMessage('connected ok!')
else ShowMessage('Somthing went wrong!");
But its much easier for the second to go wrong, and harder to figure out what went wrong.
Now run your program, fill in the edit boxes and see if it works!
I'm assuming it did - so lets move along, almost there.
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:
MySQLResult := MySQLClient.Query('SELECT * FROM users WHERE username=''username'' and password=''pass''', True, OK);
(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''')
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:
MySQLResult.FieldValueByName('username');
Hint for a login type script -
if (MySQLResult.FieldValueByName('username') <> 'dummy_username') or (MySQLResult.FieldValueByName('password') <> 'dummy_pass') then ...
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.
Special thanks to "Dumbass" who wrote the page where I first found the open source MySQL connector libraries.
2011. június 19., vasárnap
Outlook from Delphi
Problem/Question/Abstract:
Outlook from Delphi
Answer:
Automating Microsoft Outlook
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.
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.
Figure 1: The Outlook object model.
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.
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.
Figure 2: The MAPI Folders collection displayed in a Delphi form.
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.
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.
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:
Personal := Mapi.Folders('Personal Folders');
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.
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.)
Working with Contacts
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.
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:
ContactItems := Mapi.Folders('Personal Folders').
Folders('Contacts').Items;
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:
The MAPI NameSpace object
The Folders collection
The Personal Folders object
The Folders collection
The Contacts object
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:
CurrentContact := ContactItems.Find(' [CompanyName] = ' +
QuotedStr('Borland International'));
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.
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.
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.
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.
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.
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.
Other Outlook Objects
The Folders collection of the Personal Folder object contains the following folders:
Deleted Items
Inbox
Outbox
Sent Items
Calendar
Contacts
Journal
Notes
Tasks
Drafts
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.
Conclusion
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.
Begin Listing One - Displaying Outlook objects
procedure TForm1.OpenBtnClick(Sender: TObject);
var
OutlookApp,
Mapi,
Contacts,
Personal: Variant;
I: Integer;
begin
{ Get the Outlook Application object. }
OutlookApp := CreateOleObject('Outlook.Application');
{ Get the MAPI NameSpace object. }
Mapi := OutlookApp.GetNameSpace('MAPI');
{ Loop through the MAPI Folders collection and add the
Name of each folder to the listbox. }
for I := 1 to Mapi.Folders.Count do
MapiList.Items.Add(Mapi.Folders(I).Name);
{ Get the Personal folder from the MAPI folders
collection. }
Personal := Mapi.Folders('Personal Folders');
{ Loop through the Personal Folders Collection and add
the name of each folder to the listbox. }
for I := 1 to Personal.Folders.Count do
PersonalList.Items.Add(Personal.Folders(I).Name);
{ Get the Contacts folder from the Personal Folders
collection. }
Contacts := Personal.Folders('Contacts');
{ Loop through the Contacts folder's Items collection
and add the FullName property of each Item
to the listbox. }
for I := 1 to Contacts.Items.Count do
ContactsList.Items.Add(Contacts.Items(I).FullName);
{ Close Outlook. }
OutlookApp := Unassigned;
end;
End Listing One
Begin Listing Two - Searching for contacts
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);
var
OutlookApp,
Mapi,
ContactItems,
CurrentContact: Variant;
begin
{ Get the Outlook Application object. }
OutlookApp := CreateOleObject('Outlook.Application');
{ Get the MAPI NameSpace object. }
Mapi := OutlookApp.GetNameSpace('MAPI');
{ Get the Items collection from the Contacts folder. If
you don't do this, FindNext will not work. }
ContactItems := Mapi.Folders('Personal Folders').
Folders('Contacts').Items;
{ Load Contacts into table. }
with ContactTable do
begin
EmptyTable;
Open;
DisableControls;
CurrentContact :=
ContactItems.Find('[CompanyName] = ' +
QuotedStr('Borland International'));
while not VarIsEmpty(CurrentContact) do
begin
Insert;
FieldByName('EntryId').AsString :=
CurrentContact.EntryId;
FieldByName('LastName').AsString :=
CurrentContact.LastName;
FieldByName('FirstName').AsString :=
CurrentContact.FirstName;
FieldByName('CompanyName').AsString :=
CurrentContact.CompanyName;
FieldByName('BusAddrStreet').AsString :=
CurrentContact.BusinessAddressStreet;
FieldByName('BusAddrPOBox').AsString :=
CurrentContact.BusinessAddressPostOfficeBox;
FieldByName('BusAddrCity').AsString :=
CurrentContact.BusinessAddressCity;
FieldByName('BusAddrState').AsString :=
CurrentContact.BusinessAddressState;
FieldByName('BusAddrPostalCode').AsString :=
CurrentContact.BusinessAddressPostalCode;
FieldByName('BusinessPhone').AsString :=
CurrentContact.BusinessTelephoneNumber;
Post;
CurrentContact := ContactItems.FindNext;
end; // while
EnableControls;
end; // with
{ Close Outlook. }
OutlookApp := Unassigned;
end;
End Listing Two
Begin Listing Three - Creating a Contacts folder and new contacts
procedure TCreateFolderFrom.CreateBtnClick(Sender: TObject);
const
olFolderContacts = 10;
olContactItem = 2;
var
OutlookApp,
Mapi,
NewContact,
BorlandContacts,
ContactItems,
CurrentContact: Variant;
I,
ToRemove: Integer;
begin
{ Get the Outlook Application object. }
OutlookApp := CreateOleObject('Outlook.Application');
{ Get the MAPI NameSpace object. }
Mapi := OutlookApp.GetNameSpace('MAPI');
{ Get the Items collection from the Contacts folder. If
you don't do this,FindNext will not work. }
ContactItems := Mapi.Folders('Personal Folders').
Folders('Contacts').Items;
{ Remove the test folder. }
ToRemove := 0;
for I := 1 to Mapi.Folders('Personal Folders').
Folders.Count do
if Mapi.Folders('Personal Folders').Folders(I).Name =
'Borland Contacts' then
begin
ToRemove := I;
Break;
end; // if
if ToRemove <> 0 then
Mapi.Folders('Personal Folders').
Folders.Remove(ToRemove);
{ Create a new folder. }
Mapi.Folders('Personal Folders').
Folders.Add('Borland Contacts', olFolderContacts);
BorlandContacts := Mapi.Folders('Personal Folders').
Folders('Borland Contacts');
{ Load Contacts into new folder. }
CurrentContact := ContactItems.Find('[CompanyName] = ' +
QuotedStr('Borland International'));
while not VarIsEmpty(CurrentContact) do
begin
{ Add a new item to the folder. }
NewContact := BorlandContacts.Items.Add;
{ Assign values to the fields in the item record. }
NewContact.FullName := 'John Doe';
NewContact.LastName := CurrentContact.LastName;
NewContact.FirstName := CurrentContact.FirstName;
NewContact.CompanyName := CurrentContact.CompanyName;
NewContact.BusinessAddressStreet :=
CurrentContact.BusinessAddressStreet;
NewContact.BusinessAddressPostOfficeBox :=
CurrentContact.BusinessAddressPostOfficeBox;
NewContact.BusinessAddressCity :=
CurrentContact.BusinessAddressCity;
NewContact.BusinessAddressState :=
CurrentContact.BusinessAddressState;
NewContact.BusinessAddressPostalCode :=
CurrentContact.BusinessAddressPostalCode;
NewContact.BusinessTelephoneNumber :=
CurrentContact.BusinessTelephoneNumber;
{ Save the new record. }
NewContact.Save;
{ Find the next record in the Contacts folder. }
CurrentContact := ContactItems.FindNext;
end; // while
{ Close Outlook. }
OutlookApp := Unassigned;
end;
End Listing Three
Begin Listing Four - Reading Calendar folder
procedure TLoadTableForm.LoadBtnClick(Sender: TObject);
var
OutlookApp,
Mapi,
ApptItems,
CurrentAppt: Variant;
begin
{ Get the Outlook Application object. }
OutlookApp := CreateOleObject('Outlook.Application');
{ Get the MAPI NameSpace object. }
Mapi := OutlookApp.GetNameSpace('MAPI');
{ Get the Items collection from the Contacts folder. If
you don't do this, FindNext will not work. }
ApptItems := Mapi.Folders('Personal Folders').
Folders('Calendar').Items;
{ Load Contacts into table. }
with ApptTable do
begin
EmptyTable;
Open;
DisableControls;
CurrentAppt := ApptItems.Find('[Start] > ' +
'"4/27/99" and [AllDayEvent] = True');
while not VarIsEmpty(CurrentAppt) do
begin
Insert;
FieldByName('Start').AsDateTime := CurrentAppt.Start;
FieldByName('Subject').AsString :=
CurrentAppt.Subject;
FieldByName('End').AsDateTime := CurrentAppt.End;
FieldByName('Busy').AsBoolean :=
CurrentAppt.BusyStatus;
Post;
CurrentAppt := ApptItems.FindNext;
end; // while
EnableControls;
end; // with
{ Close Outlook. }
OutlookApp := Unassigned;
end;
End Listing Four
Component Download: outlook_from_delphi.zip
2011. június 18., szombat
How to create a transparent TPanel
Problem/Question/Abstract:
How to create a transparent TPanel
Answer:
Solve 1:
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).
type
TTransparentPanel = class(TPanel)
private
procedure SetParent(AParent: TWinControl); override;
procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_EraseBkGnd;
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure Invalidate; override;
end;
constructor TTransparentPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csOpaque];
end;
procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TTransparentPanel.Paint;
begin
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(0, 0, Width, Height);
Canvas.TextOut(Width div 2, Height div 2, 'Transparent');
end;
procedure TTransparentPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
{Do Nothing}
Message.Result := 1;
end;
procedure TTransparentPanel.SetParent(AParent: TWinControl);
begin
inherited SetParent(AParent);
{The trick needed to make it all work! I don't know if changing the parent's
style is a good idea, but it only removes the WS_CLIPCHILDREN style which shouldn't cause any problems.}
if Parent <> nil then
SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong
(Parent.Handle, GWL_STYLE) and not WS_ClipChildren);
end;
procedure TTransparentPanel.Invalidate;
var
Rect: TRect;
begin
Rect := BoundsRect;
if (Parent <> nil) and Parent.HandleAllocated then
InvalidateRect(Parent.Handle, @Rect, True)
else
inherited Invalidate;
end;
Solve 2:
unit TransparentPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TTransparentPanel = class(TPanel)
private
{ Private declarations }
FBackground: TBitmap;
procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
protected
{ Protected declarations }
procedure CaptureBackground;
procedure Paint; override;
public
{ Public declarations }
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property Canvas;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PBGoodies', [TTransparentPanel]);
end;
procedure TTransparentPanel.CaptureBackground;
var
canvas: TCanvas;
dc: HDC;
sourcerect: TRect;
begin
FBackground := TBitmap.Create;
with Fbackground do
begin
width := clientwidth;
height := clientheight;
end;
sourcerect.TopLeft := ClientToScreen(clientrect.TopLeft);
sourcerect.BottomRight := ClientToScreen(clientrect.BottomRight);
dc := CreateDC('DISPLAY', nil, nil, nil);
try
canvas := TCanvas.Create;
try
canvas.handle := dc;
Fbackground.Canvas.CopyRect(clientrect, canvas, sourcerect);
finally
canvas.handle := 0;
canvas.free;
end;
finally
DeleteDC(dc);
end;
end;
constructor TTransparentPanel.Create(aOwner: TComponent);
begin
inherited;
ControlStyle := controlStyle - [csSetCaption];
end;
destructor TTransparentPanel.Destroy;
begin
FBackground.free;
inherited;
end;
procedure TTransparentPanel.Paint;
begin
if csDesigning in ComponentState then
inherited
{would need to draw frame and optional caption here do not call
inherited, the control fills its client area if you do}
end;
procedure TTransparentPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if Visible and HandleAllocated and not (csDesigning in ComponentState) then
begin
Fbackground.Free;
Fbackground := nil;
Hide;
inherited;
Parent.Update;
Show;
end
else
inherited;
end;
procedure TTransparentPanel.WMEraseBkGnd(var msg: TWMEraseBkGnd);
var
canvas: TCanvas;
begin
if csDesigning in ComponentState then
inherited
else
begin
if not Assigned(FBackground) then
Capturebackground;
canvas := TCanvas.create;
try
canvas.handle := msg.DC;
canvas.draw(0, 0, FBackground);
finally
canvas.handle := 0;
canvas.free;
end;
msg.result := 1;
end;
end;
end.
Solve 3:
This panel will be transparent only at runtime.
{ ... }
type
TMyPopUpTransPanel = class(TPanel)
protected
procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
procedure WndProc(var Message: TMessage); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
end;
{ ... }
procedure TMyPopUpTransPanel.CMHitTest(var Message: TCMHitTest);
begin
Message.Result := Windows.HTNOWHERE;
end;
procedure TMyPopUpTransPanel.WndProc(var Message: TMessage);
var
XControl: TControl;
XPos: TPoint;
begin
if not (csDesigning in ComponentState) and ((Message.Msg >= WM_MOUSEFIRST)
and (Message.Msg <= WM_MOUSELAST)) then
begin
XPos := ClientToScreen(POINT(TWMMouse(Message).XPos, TWMMouse(Message).YPos));
XControl := Parent.ControlAtPos(POINT(TWMMouse(Message).XPos +
Left, TWMMouse(Message).YPos + Top), true, true);
if Assigned(XControl) and (XControl is TWinControl) then
begin
XPos := TWinControl(XControl).ScreenToClient(XPos);
TWMMouse(Message).XPos := XPos.X;
TWMMouse(Message).YPos := XPos.Y;
PostMessage(TWinControl(XControl).Handle, Message.Msg,
Message.WParam, Message.LParam);
end
else
begin
XPos := Parent.ScreenToClient(XPos);
TWMMouse(Message).XPos := XPos.X;
TWMMouse(Message).YPos := XPos.Y;
PostMessage(Parent.Handle, Message.Msg, Message.WParam, Message.LParam);
end;
Message.Result := 0;
end
else
inherited WndProc(Message);
end;
procedure TMyPopUpTransPanel.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if not (csDesigning in ComponentState) then
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TMyPopUpTransPanel.Paint;
var
XBitMap: TBitMap;
XOldDC: HDC;
XRect: TRect;
begin
if (csDesigning in ComponentState) then
inherited Paint
else
begin
XRect := ClientRect;
XOldDC := Canvas.Handle;
XBitMap := TBitMap.Create;
try
XBitMap.Height := Height;
XBitMap.Width := Width;
Canvas.Handle := XBitMap.Canvas.Handle;
inherited Paint;
RedrawWindow(Parent.Handle, @XRect, 0, RDW_ERASE or RDW_INVALIDATE or
RDW_NOCHILDREN or RDW_UPDATENOW);
finally
Canvas.Handle := XOldDC;
Canvas.BrushCopy(XRect, XBitMap, XRect, Color);
XBitMap.Free;
end;
end;
end;
2011. június 17., péntek
Installing BDE from BDEINST.CAB
Problem/Question/Abstract:
How to install BDE from BDEINST.CAB file
Answer:
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.
What is BDEINST.CAB?
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.
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.
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.
Using BDEINST.DLL
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:
Using WinZip or another CAB-compatible archiver. Simply extract BDEINST.DLL from the CAB file.
Using Microsoft's EXTRACT utility that comes with Windows 9x and NT. From a DOS window, issue the command below (path is also shown):
C:\Program Files\Borland\Common Files\BDE>EXTRACT /E BDEINST.CAB
This will extract BDEINST.DLL to the current directory, since no destination dir was specified in the command line.
The task now is to use the DLL. This is as simple as issuing the command line below:
C:\WINDOWS\SYSTEM\REGSVR32.EXE /S CABINST.DLL
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.
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.
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.
2011. június 16., csütörtök
How to store records in a TList when their number is unknown until runtime
Problem/Question/Abstract:
How to store records in a TList when their number is unknown until runtime
Answer:
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.
type
TRecord = record { the record type }
{ ... }
end;
PRecord = ^TRecord; { pointer type for pointers to TRecords }
TRecordList = class(TList) { a customized version of TList to hold PRecord pointers }
private
procedure SetRecord(index: Integer; Ptr: PRecord);
function GetRecord(index: Integer): PRecord;
public
procedure Clear;
destructor Destroy; override;
property Records[i: Integer]: PRecord read GetRecord write SetRecord;
end;
{Methods of TRecordList}
procedure TRecordList.SetRecord(index: Integer; Ptr: PRecord);
var
p: PRecord;
begin
{ get the pointer currently in slot index }
p := Records[index];
if p <> Ptr then
begin
{ 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! }
if p <> nil then
Dispose(p);
{ store the passed pointer into the slot }
Items[index] := Ptr;
end;
end;
function TRecordList.GetRecord(index: Integer): PRecord;
begin
{ return the pointer in slot index, typecast to PRecord }
Result := PRecord(Items[index]);
end;
procedure TRecordList.Clear;
var
i: Integer;
p: PRecord;
begin
{ dispose of the memory pointed to by all pointers in the list that are not Nil }
for i := 0 to Pred(Count) do
begin
p := Records[i];
if p <> nil then
Dispose(p);
end;
{ call the Clear method inherited from TList to set Count to 0 }
inherited Clear;
end;
destructor TRecordList.Destroy;
begin
{ clear the list to dispose of any pointers still stored first }
Clear;
inherited Destroy;
end;
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.
{ in a forms public section: }
RecordList: TRecordList;
{ in the forms OnCreate handler }
RecordList := TRecordList.Create;
{ in the forms OnDestroy handler }
RecordList.Free;
To add a record to the list you use code like this:
var
Ptr: PRecord; { local variable in a method }
New(Ptr); { allocate a record on the heap }
with Ptr^ do
begin { note the caret to dereference the pointer }
{ put data into the fields of the record }
end;
recordIndex := RecordList.Add(Ptr);
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.
2011. június 15., szerda
How to prevent csOpaque child controls from flickering
Problem/Question/Abstract:
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?
Answer:
{ Overrides the WM_ERASEBKGND message in TWinControl and TForm to prevent flicker of csOpaque child controls.
Unpublished; (c) 1999, David Best, davebest@usa.net
You are free to use this and derived works provided you acknowlege it's source in your code.}
procedure WMEraseBkgndEx(WinControl: TWinControl; var Message: TWmEraseBkgnd);
var
i, Clip, SaveIndex: Integer;
begin
{ Only erase background if we're not doublebuffering or painting to memory }
with WinControl do
if not DoubleBuffered or (TMessage(Message).wParam = TMessage(Message).lParam) then
begin
SaveIndex := SaveDC(Message.DC);
Clip := SimpleRegion;
if ControlCount > 0 then
begin
for i := 0 to ControlCount - 1 do
if not (Controls[i] is TWinControl) then
{child windows already excluded}
with Controls[i] do
begin
if (Visible or (csDesigning in ComponentState) and not
(csNoDesignVisible in ControlStyle))
and (csOpaque in ControlStyle) then
begin
Clip := ExcludeClipRect(Message.DC, Left, Top, Left +
Width, Top + Height);
if Clip = NullRegion then
break;
end;
end;
end;
if Clip <> NullRegion then
FillRect(Message.DC, ClientRect, Brush.Handle);
RestoreDC(Message.DC, SaveIndex);
end;
Message.Result := 1;
end;
procedure TNoFlickerForm.WMEraseBkGnd(var msg: TWMEraseBkGnd);
begin
WMEraseBkgndEx(Self, msg);
end;
2011. június 14., kedd
Delphi Frames
Problem/Question/Abstract:
Understanding Delphi 5's New Visual Container Class
Answer:
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.
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.
Overview of Frames
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).
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.
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.
Creating a Frame
The following steps demonstrate how to create a frame (the code for this project is available for download; see end of article for details).
Select File | New Application to create a new project.
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.
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.
Figure 1: A simple frame for displaying an ID number, as well as a first and last name.
That's all there is to creating a frame. The following section demonstrates how to put it to use.
Using a Frame
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:
Select Form1 of the application you created in the preceding steps.
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.
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).
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.
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.
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.
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.
Save this project and then run it. The running project will look something like that shown in Figure 5.
Figure 2: A form ready for the placement of frames.
Figure 3: The Select frame to insert dialog box.
Figure 4: Two instances of NameFrame appear on this form.
Figure 5: The example frame project at run time.
Frames and Inheritance
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.
You can demonstrate this by following these steps:
With the project created in the preceding section, press [Shift][F12] and select NameFrame from the displayed list of forms.
Set the AutoEdit property of the DataSource to False.
Next, select the DBNavigator, expand its VisibleButtons property, and set the nbInsert, nbDelete, nbEdit, nbPost, and nbCancel flags to False.
Now look at your main form. Notice that both NameFrame descendants have inherited the changes you made to the frame (see Figure 6).
Figure 6: Updating NameFrame automatically causes all instances to be updated as well.
Overriding Contained Component Properties
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:
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:.
Press [Shift][F12] and select NameFrame. Change the caption of this ID label to Identifier.
Return to the main form. Notice that the Caption properties of the labels haven't changed to Identifier. They still use their overridden values.
This effect is accomplished through information stored in the DFM file. Figure 7 displays a relevant part of the DFM file for this project.
Figure 7: A DFM file containing property overrides for a frame instance.
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.
Contained Object Event Handlers
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.
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.
Figure 8: A frame with components that have event handlers.
procedure TTwoButtonFrame.Button1Click(Sender: TObject);
begin
if (TComponent(Sender).Tag = 0) or
(Application.HelpFile = '') then
MessageBox(Application.Handle, 'Help not available',
'Help', MB_OK)
else
Application.HelpContext(TComponent(Sender).Tag);
end;
procedure TTwoButtonFrame.Button2Click(Sender: TObject);
var
AParent: TComponent;
begin
AParent := TComponent(Sender).GetParentComponent;
while not (AParent is TCustomForm) do
AParent := AParent.GetParentComponent;
TCustomForm(AParent).Close;
end;
Figure 9: The OnClick event handlers for the Help and Done buttons on our frame.
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.)
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.
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.
Overriding Contained Object Event Handlers
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.
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:
procedure TForm1.TwoButtonFrame1Button2Click(
Sender: object);
begin
TwoButtonFrame1.Button2Click(Sender);
end;
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.
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.
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.
procedure TForm1.TwoButtonFrame1Button2Click(
Sender: TObject);
begin
with TForm2.Create(Self) do
begin
ShowModal;
Release;
end;
// The following is the original, auto-generated code
// TwoButtonFrame1.Button2Click(Sender);
end;
Figure 10: An overridden event handler for a TwoButtonFrame descendant that was placed on a form.
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.
Figure 11: This TwoButtonFrame instance overrides both the caption and the OnClick event handler.
Frames that Save Resources
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.
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.
The reason for this can be seen if you consider the following segment of the DFM file for the form shown in Figure 11:
inline LogoFrame1: TLogoFrame
Left = 6
Top = 6
Width = 211
Height = 182
inherited Image1: TImage
Width = 211
Height = 182
end
end
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.
object LogoFrame: TLogoFrame
Left = 0
Top = 0
Width = 239
Height = 178
TabOrder = 0
object Image1: TImage
Left = 0
Top = 0
Width = 239
Height = 178
Align = alClient
Picture.Data = {
07544269746D6170D6540000424DD654000000000000760000...
Figure 12: A segment of LogoFrame's DFM file.
Simplifying Frame Use
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.
Adding a Frame to the Component Palette
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:
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.
Select the frame and right-click on it. Select Add to Palette. Delphi displays the Component Template Information dialog box (see Figure 13).
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.
Figure 13: The Component Template Information dialog box.
Using a Frame from the Component Palette
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.
Adding a Frame to the Object Repository
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:
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.
Right-click the frame and select Add To Repository. Delphi responds by displaying the Add To Repository dialog box (see Figure 14).
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.
Figure 14: The Add To Repository dialog box.
Using a Frame from the Object Repository
To use a frame from the Object Repository, use the following steps:
Select File | New.
Select the page of the Object Repository to which you saved your frame template (see Figure 15).
Select the icon for the frame; then select the Inherit radio button.
Click OK to add an inherited version of the frame to your project.
Figure 15: The location of your frame template.
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.
Conclusion
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.
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.
Component Download: delphi_frames.zip
2011. június 13., hétfő
How to draw buttons on the title bar of a TForm
Problem/Question/Abstract:
How to draw buttons on the title bar of a TForm
Answer:
Solve 1:
Place an icon-sized TImage on a form and add the following code:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
private
{Private declarations}
TitleBarCanvas: TCanvas;
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
procedure DrawExtraStuff;
public
{Public declarations}
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
NonClientMetrics: TNonClientMetrics;
begin
TitleBarCanvas := TCanvas.Create;
TitleBarCanvas.Handle := GetWindowDC(Handle);
NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0);
TitleBarCanvas.Font.Handle := CreateFontIndirect(NonClientMetrics.lfCaptionFont);
TitleBarCanvas.Brush.Style := bsClear;
Caption := '';
end;
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawExtraStuff;
end;
procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
if Msg.Active then
TitleBarCanvas.Font.Color := clCaptionText
else
TitleBarCanvas.Font.Color := clInactiveCaptionText;
DrawExtraStuff;
end;
procedure TForm1.DrawExtraStuff;
var
X, Y, TransColor: Integer;
begin
{set the transparent color to bottom left pixel}
TransColor := Image1.Canvas.Pixels[0, Image1.Picture.Height - 1];
with Image1 do
for x := 0 to Picture.Width - 1 do
for y := 0 to Picture.Height - 1 do
if Canvas.Pixels[x, y] <> TransColor then
TitleBarCanvas.Pixels[22 + x, 5 + y] := Canvas.Pixels[x, y];
TitleBarCanvas.TextOut(40, 6, '<- Here is the other icon');
end;
end.
Solve 2:
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.
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.
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.
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.
Let's look at a list of things that we need to consider to add a button to the title bar of a form:
We need to have a function to draw the button
We'll have to trap drawing and painting events so that our button stays visible when the form activates, resizes, or moves
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.
I'll now discuss these topics, in the above order.
Drawing a TRect as a Button
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:
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.
All this is accomplished in a single call. For this program we make a call to a procedure called DrawTitleButton, which is listed below:
procedure TTitleBtnForm.DrawTitleButton;
var
bmap: TBitmap; {Bitmap to be drawn - 16 x 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit: Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
XTtlBit + 2, YTtlBit + 2);
{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
XTtlBit + 2, YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
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).
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.
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.
Trapping the Drawing and Painting Events
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:
{Paint triggering events}
procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
DrawTitleButton;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
{Painting events}
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawTitleButton;
end;
procedure TForm1.WMSetText(var Msg: TWMSetText);
begin
inherited;
DrawTitleButton;
end;
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.
Handling Mouse Clicks
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:
{Mouse-related procedures}
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
procedure TForm1.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;
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.
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.
Putting it All Together
Let's look at the entire code in the form to see how it all works together:
unit Capbtn;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs,
Buttons;
type
TTitleBtnForm = class(TForm)
procedure FormResize(Sender: TObject);
private
TitleButton: TRect;
procedure DrawTitleButton;
{Paint-related messages}
procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
{Mouse down-related messages}
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
function GetVerInfo: DWORD;
end;
var
TitleBtnForm: TTitleBtnForm;
const
htTitleBtn = htSizeLast + 1;
implementation
{$R *.DFM}
procedure TTitleBtnForm.DrawTitleButton;
var
bmap: TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit: Integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
{$IFNDEF WIN32}
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
XTtlBit + 2, YTtlBit + 2);
{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2), YFrame - 1,
XTtlBit + 2, YTtlBit + 2)
else
TitleButton := Bounds(Width - XFrame - 4 * XTtlBit + 2, XFrame + 2, XTtlBit + 2,
YTtlBit + 2);
{$ENDIF}
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
bmap := TBitmap.Create;
bmap.LoadFromFile('help.bmp');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 2, Top + 2, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
{$ENDIF}
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
{Paint triggering events}
procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
DrawTitleButton;
end;
procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
{Painting events}
procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawTitleButton;
end;
procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);
begin
inherited;
DrawTitleButton;
end;
{Mouse-related procedures}
procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
ShowMessage('You pressed the new button');
end;
function TTitleBtnForm.GetVerInfo: DWORD;
var
verInfo: TOSVERSIONINFO;
begin
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verInfo) then
Result := verInfo.dwPlatformID;
{Returns:
VER_PLATFORM_WIN32s -- Win32s on Windows 3.1
VER_PLATFORM_WIN32_WINDOWS -- Win32 on Windows 95
VER_PLATFORM_WIN32_NT -- Windows NT }
end;
end.
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.
Solve 3:
unit TitleBtn;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Forms, Dialogs,
Buttons, Controls, StdCtrls, ExtCtrls;
type
TTitleBtnForm = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
function GetSystemTitleBtnCount: integer;
procedure KillHint;
private
TitleButton: TRect;
FActive: boolean;
FHint: THintWindow;
Timer2: TTimer;
procedure DrawTitleButton(i: integer);
{Paint-related messages}
procedure WMSetText(var Msg: TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
{Mouse-related messages}
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHitTest;
procedure WMNCLButtonDown(var Msg: TWMNCLButtonDown);
message WM_NCLBUTTONDOWN;
procedure WMNCLButtonUp(var Msg: TWMNCLButtonUp); message WM_NCLBUTTONUP;
procedure WMNCMouseMove(var Msg: TWMNCMouseMove); message WM_NCMouseMove;
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
{-}
function GetVerInfo: DWORD;
{-}
procedure ShowHint;
procedure Timer2Timer(Sender: TObject);
public
end;
const
htTitleBtn = htSizeLast + 1;
implementation
uses
PauLitaData, About, SpoolMessages;
procedure TTitleBtnForm.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
procedure TTitleBtnForm.DrawTitleButton(i: integer);
var
bmap: TBitmap; {Bitmap to be drawn - 16x16: 16 Colors}
XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit: integer;
n: integer;
begin
{Get size of form frame and bitmaps in title bar}
XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
n := GetSystemTitleBtnCount;
if GetVerInfo = VER_PLATFORM_WIN32_NT then
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1 - 3, YFrame + 1 - 3,
XTtlBit - 2, YTtlBit - 4)
else
TitleButton := Bounds(Width - XFrame - (n + 1) * XTtlBit + 1, YFrame + 1, XTtlBit
- 2, YTtlBit - 4);
Canvas.Handle := GetWindowDC(Self.Handle);
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, FALSE, FALSE, FALSE);
bmap := TBitmap.Create;
DataModule1.ImageList1.GetBitmap(i, bmap);
with TitleButton do
if GetVerInfo = VER_PLATFORM_WIN32_NT then
Canvas.Draw(Left + 2, Top + 2, bmap)
else
Canvas.StretchDraw(TitleButton, bmap);
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
Canvas.Handle := 0;
end;
end;
procedure TTitleBtnForm.WMSetText(var Msg: TWMSetText);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
DrawTitleButton(0);
end;
procedure TTitleBtnForm.WMNCLButtonDown(var Msg: TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
DrawTitleButton(1);
end;
procedure TTitleBtnForm.WMNCLButtonUp(var Msg: TWMNCLButtonUp);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
begin
KillHint;
ShowAboutBox;
end;
end;
procedure TTitleBtnForm.WMNCMouseMove(var Msg: TWMNCMouseMove);
begin
inherited;
if (Msg.HitTest = htTitleBtn) and PtinRect(TitleButton, Point(Msg.XCursor - Left,
Msg.YCursor - Top)) then
ShowHint
else
KillHint;
end;
function TTitleBtnForm.GetVerInfo: DWORD;
var
verinfo: TOSVERSIONINFO;
begin
verinfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verinfo) then
Result := verinfo.dwPlatformID;
end;
procedure TTitleBtnForm.WMNCHitTest(var Msg: TWMNCHitTest);
begin
inherited;
with Msg do
begin
if PtinRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
end;
end;
function TTitleBtnForm.GetSystemTitleBtnCount: integer;
var
Menu: HMenu;
i, n, m, l: integer;
begin
l := 0;
Menu := GetSystemMenu(Handle, FALSE);
n := GetMenuItemCount(Menu);
for i := 0 to n - 1 do
begin
m := GetMenuItemID(Menu, i);
if (m = SC_RESTORE) or (m = SC_MAXIMIZE) or (m = SC_CLOSE) then
Inc(l)
else if (m = SC_MINIMIZE) then
Inc(l, 2);
end;
Result := l;
end;
procedure TTitleBtnForm.KillHint;
begin
if Assigned(Timer2) then
begin
Timer2.Enabled := FALSE;
Timer2.Free;
Timer2 := nil;
end;
if Assigned(FHint) then
begin
FHint.ReleaseHandle;
FHint.Free;
FHint := nil;
end;
FActive := FALSE;
end;
procedure TTitleBtnForm.Timer2Timer(Sender: TObject);
var
thePoint: TPoint;
theRect: TRect;
Count: DWORD;
i: integer;
begin
Timer2.Enabled := FALSE;
Timer2.Free;
Timer2 := nil;
thePoint.X := TitleButton.Left;
thePoint.Y := TitleButton.Bottom - 25;
with theRect do
begin
topLeft := ClientToScreen(thePoint);
Right := Left + Canvas.TextWidth(MsgAbout) + 10;
Bottom := Top + 14;
end;
FHint := THintWindow.Create(Self);
FHint.Color := clInfoBk;
FHint.ActivateHint(theRect, MsgAbout);
for i := 1 to 7 do
begin
Count := GetTickCount;
repeat
{Application.ProcessMessages;}
until
(GetTickCount - Count >= 18);
with theRect do
begin
Inc(Top);
Inc(Bottom);
FHint.SetBounds(Left, Top, FHint.Width, FHint.Height);
FHint.Update;
end;
end; { i }
FActive := TRUE;
end;
procedure TTitleBtnForm.ShowHint;
begin
if FActive then
Exit;
if Assigned(Timer2) then
Exit;
Timer2 := TTimer.Create(Self);
Timer2.Interval := 500;
Timer2.OnTimer := Timer2Timer;
Timer2.Enabled := TRUE;
end;
procedure TTitleBtnForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y:
Integer);
begin
inherited;
KillHint;
end;
procedure TTitleBtnForm.FormCreate(Sender: TObject);
begin
OnMouseMove := FormMouseMove;
end;
end.
Feliratkozás:
Bejegyzések (Atom)