How to close the help file when terminating the program

Problem/Question/Abstract:

How to close the help file when terminating the program

Answer:

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Winhelp(Handle, 'WinHelp.Hlp', HELP_QUIT, 0);
  Action := caFree;
end;

How to break strings into individual tokens (substrings)

Problem/Question/Abstract:

How to break strings into individual tokens (substrings)

Answer:

The following (simple) functions helped me handling substrings:

function GetToken(aString, SepChar: string; TokenNum: Byte): string;

{Parameters:
aString: the complete string
SepChar: a single character used as separator between the substrings
TokenNum: the number of the substring you want
result: the substring or an empty string if the are less then 'TokenNum' substrings}

var
  Token: string;
  StrLen: Byte;
  TNum: Byte;
  TEnd: Byte;
begin
  StrLen := Length(aString);
  TNum := 1;
  TEnd := StrLen;
  while ((TNum <= TokenNum) and (TEnd <> 0)) do
  begin
    TEnd := Pos(SepChar, aString);
    if TEnd <> 0 then
    begin
      Token := Copy(aString, 1, TEnd - 1);
      Delete(aString, 1, TEnd);
      Inc(TNum);
    end
    else
    begin
      Token := aString;
    end;
  end;
  if TNum >= TokenNum then
  begin
    GetToken1 := Token;
  end
  else
  begin
    GetToken1 := '';
  end;
end;

function NumToken(aString, SepChar: string): Byte;

{Parameters:
aString: the complete string
SepChar: a single character used as separator between the substrings
result: the number of substrings}

var
  RChar: Char;
  StrLen: Byte;
  TNum: Byte;
  TEnd: Byte;
begin
  if SepChar = ' # ' then
  begin
    RChar := ' * '
  end
  else
  begin
    RChar := ' # '
  end;
  StrLen := Length(aString);
  TNum := 0;
  TEnd := StrLen;
  while TEnd <> 0 do
  begin
    Inc(TNum);
    TEnd := Pos(SepChar, aString);
    if TEnd <> 0 then
    begin
      aString[TEnd] := RChar;
    end;
  end;
  NumToken1 := TNum;
end;

How to load a TImageList from a resource file

Problem/Question/Abstract:

Is there a way to load all the icons at once from a BMP into a TImageList? Is there a way to save all the images in a TImageList to a BMP file?

Answer:

The best way to load an imagelist from a resource is to pack all images into one bitmap and load them all in one go. For this you need the bitmap, of course.

So, create a new project, drop a TImagelist on the form and add the icons to it at design-time, as usual. Add a handler for the forms OnCreate event and do this in the handler:

var
  bmp: TBitmap;
  i: integer;
begin
  bmp := TBitmap.Create;
  try
    bmp.width := imagelist1.width * imagelist1.count;
    bmp.height := imagelist1.height;
    with bmp.canvas do
    begin
      brush.color := clOlive;
      brush.style := bsSolid;
      fillrect(cliprect);
    end;
    for i := 0 to imagelist1.count - 1 do
      imagelist1.draw(bmp.canvas, i * imagelist1.width, 0, i);
    bmp.savetofile('d:\temp\images.bmp');
  finally
    bmp.free
  end;
end;

The result is a "strip" bitmap with all images in the list. Open this bitmap in MSPaint and save it again under the same name as a 256 or 16 color bitmap, it will usually have a higher color depth since the VCL creates bitmaps with the color depth of your current video mode by default. The "transparent" color for this bitmap is clOlive, since that is what we filled the bitmap with before painting the images on it transparently.

The next step is to add this bitmap to a resource file and add the resource to your project. You can do that with the image editor as usual or create a RC file and add it to your project group (requires D5). The RC file would contain a line like

IMAGES1 BITMAP d:\temp\images.bmp

You can now load this resource into your projects imagelist with

imagelist2.ResInstLoad(HInstance, rtBitmap, 'IMAGES1', clOlive);

Note that the width and height setting of the imagelist has to be the same as the one you saved the images from, otherwise the bitmap will not be partitioned correctly.

Get a list of dates of specific days in a given date range

Problem/Question/Abstract:

Can anyone help with a routine that will return a list of dates of specific days in a given date range? For example, I want a list of dates of the third Monday of each month in a given date range. The user will be able to nominate the date range, the day of the week, and which day (i.e. 1st, 2nd, 3rd or 4th).

Answer:

The procedure to call is ListDates(). The important function is DateInPeriod(). Because of DayOfWeek(), Sunday is WeekDay = 1. Tested briefly.

function ValidateWeekDay(const WeekDay: Word): Word;
begin
  Result := WeekDay mod 7;
  if Result = 0 then
    Result := 7;
end;

function DayInMonth(const Year, Month, WeekDay, Nr: Word): Word;
var
  MonthStart, Shift: Word;
begin
  MonthStart := DayOfWeek(EncodeDate(Year, Month, 1));
  Shift := ValidateWeekDay(8 + WeekDay - MonthStart);
  Result := Shift + (7 * (Nr - 1));
end;

function DateInPeriod(const Date, FromDate, ToDate: TDate): Boolean;
begin
  Result := (Trunc(Date) >= Trunc(FromDate)) and (Trunc(Date) <= Trunc(ToDate))
end;

procedure ListDates(const FromDate, ToDate: TDate; const WeekDay, Nr: Word;
  const DatesList: TStrings);
var
  Year, Month, Day: Word;
  Date: TDate;

  procedure NextMonth;
  begin
    if Month = 12 then
    begin
      Month := 1;
      inc(Year);
    end
    else
      inc(Month);
  end;

begin
  DatesList.Clear;
  DecodeDate(FromDate, Year, Month, Day);
  while EncodeDate(Year, Month, 1) <= Trunc(ToDate) do
  begin
    Date := EncodeDate(Year, Month, DayInMonth(Year, Month, WeekDay, Nr));
    if DateInPeriod(Date, FromDate, ToDate) then
      DatesList.Add(FormatDateTime(ShortDateFormat, Date));
    NextMonth;
  end;
end;

How to move any component at runtime

Problem/Question/Abstract:

How to move any component at runtime

Answer:

Solve 1:

There is a simple trick for allowing the user to move components at runtime. However, this will only work for components which derive from a TWinControl as it requires a Handle property. The solution I am about to give will work with ANY component. Although it uses the same method, I have achieved moving components without a handle property by temporarily placing them inside a TPanel. Make sure ExtCtrls is in your USES clause, then point the OnMouseDown event for each component at the following code:


procedure TForm1.MoveControl(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  TempPanel: TPanel;
  Control: TControl;
begin
  {Release the MOUSEDOWN status}
  ReleaseCapture;
  {If the component is a TWinControl, just move it directly}
  if Sender is TWinControl then
    TWinControl(Sender).Perform(WM_SysCommand, $F012, 0)
  else
  try
    Control := TControl(Sender);
    TempPanel := TPanel.Create(Self);
    with TempPanel do
    begin
      {Replace the component with TempPanel}
      Caption := '';
      BevelOuter := bvNone;
      SetBounds(Control.Left, Control.Top, Control.Width, Control.Height);
      Parent := Control.Parent;
      {Put our control in TempPanel}
      Control.Parent := TempPanel;
      {Move TempPanel with control inside of it}
      Perform(WM_SysCommand, $F012, 0);
      {Put the component where the panel was dropped}
      Control.Parent := Parent;
      Control.Left := Left;
      Control.Top := Top;
    end;
  finally
    TempPanel.Free;
  end;
end;


Solve 2:

unit Unit1;

interface

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

type
  TControlDragKind = (dkNone, dkTopLeft, dkTop, dkTopRight, dkRight, dkBottomRight,
    dkBottom, dkBottomLeft, dkLeft, dkClient);

  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
    FDownPos: TPoint; { position of last mouse down, screen-relative }
    FDragKind: TcontrolDragKind; { kind of drag in progress }
    procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    function GetDragging: Boolean;
  public
    { Public declarations }
    property DraggingControl: Boolean read GetDragging;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  { Set of cursors to use while moving over and dragging on controls. }
  DragCursors: array[TControlDragKind] of TCursor =
  (crDefault, crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE,
    crSizeNWSE, crSizeNS, crSizeNESW, crSizeWE, crHandPoint);
  {Width of "hot zone" for dragging around the control borders. }
  HittestMargin = 3;

type
  TCracker = class(TControl); { Needed since TControl.MouseCapture is protected }

  { Perform hittest on the mouse position. Position is in client coordinates for the passed control. }

function GetDragKind(control: TControl; X, Y: Integer): TControlDragKind;
var
  r: TRect;
begin
  r := control.Clientrect;
  Result := dkNone;
  if Abs(X - r.left) <= HittestMargin then
    if Abs(Y - r.top) <= HittestMargin then
      Result := dkTopLeft
    else if Abs(Y - r.bottom) <= HittestMargin then
      Result := dkBottomLeft
    else
      Result := dkLeft
  else if Abs(X - r.right) <= HittestMargin then
    if Abs(Y - r.top) <= HittestMargin then
      Result := dkTopRight
    else if Abs(Y - r.bottom) <= HittestMargin then
      Result := dkBottomRight
    else
      Result := dkRight
  else if Abs(Y - r.top) <= HittestMargin then
    Result := dkTop
  else if Abs(Y - r.bottom) <= HittestMargin then
    Result := dkBottom
  else if PtInRect(r, Point(X, Y)) then
    Result := dkClient;
end;

procedure TForm1.FormClick(Sender: TObject);
var
  pt: TPoint;
begin
  {get cursor position, convert to client coordinates}
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  {create label with top left corner at mouse position}
  with TLabel.Create(Self) do
  begin
    Autosize := False; { Otherwise resizing is futile. }
    SetBounds(pt.x, pt.y, width, height);
    Caption := Format('Hit at %d, %d', [pt.x, pt.y]);
    Color := clBlue;
    Font.Color := clWhite;
    Parent := Self;
    {attach the drag handlers}
    OnMouseDown := ControlMouseDown;
    OnMouseUp := ControlMouseUp;
    OnMouseMove := ControlMouseMove;
  end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  { Go into drag mode if left mouse button went down and no modifier key is pressed. }
  if (Button = mbLeft) and (Shift = [ssLeft]) then
  begin
    { Determine where on the control the mouse went down. }
    FDragKind := GetDragKind(Sender as TControl, X, Y);
    if FDragKind <> dkNone then
    begin
      with TCracker(Sender) do
      begin
        { Record current position screen-relative, the origin for the client-relative position will move if the form is moved or resized on left/top sides. }
        FDownPos := ClientToScreen(Point(X, Y));
        MouseCapture := True;
        Color := clRed;
      end;
    end;
  end;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  dx, dy: Integer;
  pt: TPoint;
  r: TRect;
begin
  { Set controls cursor depending on position in control. }
  (Sender as TControl).Cursor := DragCursors[GetDragKind(TControl(Sender), X, Y)];
  { If we are dragging the control, get amount the mouse has moved since last call
  and calculate a new boundsrect for the control from it, depending on drag mode. }
  if DraggingControl then
    with Sender as TControl do
    begin
      pt := ClientToScreen(Point(X, Y));
      dx := pt.X - FDownPos.X;
      dy := pt.Y - FDownPos.Y;
      { Update stored mouse position to current position. }
      FDownPos := pt;
      r := BoundsRect;
      case FDragKind of
        dkTopLeft:
          begin
            r.Left := r.Left + dx;
            r.Top := r.Top + dy;
          end;
        dkTop:
          begin
            r.Top := r.Top + dy;
          end;
        dkTopRight:
          begin
            r.Right := r.Right + dx;
            r.Top := r.Top + dy;
          end;
        dkRight:
          begin
            r.Right := r.Right + dx;
          end;
        dkBottomRight:
          begin
            r.Right := r.Right + dx;
            r.Bottom := r.Bottom + dy;
          end;
        dkBottom:
          begin
            r.Bottom := r.Bottom + dy;
          end;
        dkBottomLeft:
          begin
            r.Left := r.Left + dx;
            r.Bottom := r.Bottom + dy;
          end;
        dkLeft:
          begin
            r.Left := r.Left + dx;
          end;
        dkClient:
          begin
            OffsetRect(r, dx, dy);
          end;
      end;
      { Don't let the control be resized to nothing }
      if ((r.right - r.left) > 2 * HittestMargin) and ((r.bottom - r.top) > 2 *
        HittestMargin) then
        Boundsrect := r;
    end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if DraggingControl then
  begin
    { Revert to non-dragging state. }
    FDragKind := dkNone;
    with TCracker(Sender) do
    begin
      MouseCapture := False;
      Color := clBlue;
    end;
  end;
end;

{ Read method for ControlDragging property, returns true if form is in drag mode. }

function TForm1.GetDragging: Boolean;
begin
  Result := FDragKind <> dkNone;
end;

end.


Solve 3:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    LastX, LastY: Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  with (Sender as TPanel) do
  begin
    if csLButtonDown in ControlState then
    begin
      Left := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X,
        ClientToScreen(Point(Left, Top)).Y)).X + (X - LastX);
      Top := ScreenToClient(Point(ClientToScreen(Point(Left, Top)).X,
        ClientToScreen(Point(Left, Top)).Y)).Y + (Y - LastY);
    end;
  end;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  LastX := X;
  LastY := Y;
end;

end.

Introduction to COM

Problem/Question/Abstract:

Introduction to COM

Answer:

Introduction

A few months ago, while I was looking for my first house, I spent quite a lot of time with a real estate agent which taught me the three most important elements in business marketing: location, location, location.

Well, in the Component Object Model (COM) this can be translated in integration, integration, integration while location is ideally the last thing you are interested in. Every Windows user deals with COM every day, knowing it or not. COM is used by Microsoft Office when we run the spell check utility, is used by many web sites running IIS and is also used by the underlying operating system for some of its mundane tasks. Many others instead choose COM to build complex, scalable and secure enterprise systems.

Component oriented integration is what COM is all about.

Intergration yesterday

The general meaning of the word integration is "to make into a whole by bringing all parts together; unify". In our field, this can be done in many ways and can be applied to many things: imagine you are developing a word processor application. You will create or inherit a custom memo box for editing purposes, you may include a spell checker and, if you want to get fancy, you may also want to include a set of custom routines that will allow your users to convert the document to HTML or RTF. The integration of all these parts will make your word processor.

Now, imagine that for some reasons, you want to be able to update any of these single elements without redeploying the whole application. You may also want to make those components available to a second application, maybe developed by somebody else in another language. These capabilities are very common today.

Todays applications are much bigger than they used to be few years ago and anything that can help managing this complexity is welcome.

The first approach you may try is using DLLs. Dynamic linking is the ability to bind and invoke executable code at runtime. In that hypothetical word processor, the DLL that includes the conversion routines may export functions such as:

function GetConverters: TConverterList;
  procedure Convert(anID: integer; aDocument, aFileName: string);

TConverter = record
  ID: integer;
  Name, FileExtension, Description: string;
end;

Any time we want to add a converter you'd only have to update the DLL and the word processor would automatically have access to the new functionality. This works fine and you will achieve what your objective. GetConverters returns a custom TList which may have some methods in pure Delphi style that make it very handy and easy to use (a TConverterList). Unfortunately this is not an optimal solution and, worst of all, it doesn't work unless you are using Delphi or Borland C++ Builder... In order to use the result of the function GetConverters pointer as a TConverterList, the client needs to know what a TConverterList is. In order to do this, we need to inject into our client that information but still, even if we do this we'd have a problem with non-Borland compilers. TList is a VCL class. It is not included for instance in Microsoft Visual C++ or Visual Basic. Those developers couldn't benefit in any way from the pointer we return.You could have structured your DLL differently, following for instance the approach of the Windows API EnumWindows which takes a pointer to a call back routine. Another solution could have been exporting more functions. Whichever approach you may chose you'd still be confined in a word of simple data types which is everything but object oriented and, in top of that, the DLL has to be run on the client's computer... COM is one of the technologies that help us to solving some of those issues.

Integration, today

COM has a long story. Officially the acronym COM was born somewhere around 1993. We can trace COM roots back to Windows 3.x where DDE and OLE were used in Microsoft Word and Excel as a sort of rudimentary communication and inter operability glue. Today COM is everywhere on the Windows platform. Small applications such as ICQ, CuteFTP or Allaire HomeSite are accessible through COM. Applications suites such as Microsoft Office are based on it. Windows based enterprise systems leverage COM and Microsoft Transaction Server for business critical operations. If you develop on Windows you will have to face COM sooner or later. The faster you'll do it, the better it will be. This article is about understanding COM and the reasons behind it rather than an providing another how-to tutorial. I will start with the basic principles behind COM and then I provide a concrete example. The first part won't take long but will definitely give you a better understanding of what happens in the example and why that happens. Make sure you download the sample by clicking here. The factors that lead to COM are the followings: Object Oriented language independence Dynamic Linking Location independence.

Object Oriented language independence

The DLL example above had a serious problem: in order for functions to return an object, the client has to know its interface. An interface is a very important concept in both object oriented programming and COM. An interface is the declaration of all the public methods and properties of a class. Without knowing it, that pointer could be anything and the compiler wouldn't know how to find the correct method addresses, the parameters and result types of them, etc. Does COM allow me to return objects without knowing their interface? No, although it may look that way in some cases. The concept of interface is the heart of COM. In order to be language independent, COM defines a binary standard for interface definition and introduces the concept of type libraries. Type libraries are binary files that contain information about a numbers of interfaces (you define how many you want to declare and what you want them to look like). From inside Delphi, open the type library COMConverter.tlb contained in the COMConverter directory. You will see the following window opening:  



This is the Borland type library editor which allows us to look and edit COM type libraries. As you can see, this type library defines the interface IConverterList which contains the properties Count and Items in perfect Delphi style. Delphi knows how to interpret type libraries and through the type libray editor, presents them in a user- friendly fashion. Visual Basic, Borland C++ Builder or Visual C++ do the same. They all agreed to support the COM binary standard and to play according to its rules. Now, from within the type library editor, press F12. Delphi will create a unit named COMConverter_TLB.pas  



Through COM I can define an interface that I am sure other COM enabled languages can understand. Delphi will use that information to generate interfaces that it can understand and use, as we just saw. It's all there and ready to be used now, almost as it was a regular Delphi object. There are some key differences but for now, let's continue with the principles.

Dynamic Linking

Similarly to DLLs, COM allows (and actually only works through) dynamic linking. You can choose to take advantage of this in two ways: early binding or late binding. Before we continue there's an important thing you need to do: register your COM library. Registration is the process through which Windows becomes aware of a COM object and learns how to instantiate it. In order to do this you need to use a special tool called RegSvr32.exe (contained in Windows\System32) or the Borland's equivalent TRegSvr.exe (contained in Program Files\Borland\Delphi5\Bin). Another way of doing it, when you have the Delphi source code, is to open the COM project (in our case COMConverter.dpr) and press Run\Register ActiveX Server. Registering a COM server means inserting special keys into the Windows registry. The information you will store include the name of the DLL or EXE file that hosts your COM object, the identifiers that uniquely identify it (see the yellow on green code above) and a few extra things. If you don't do this Windows won't be able to instantiate your COM object. By continuing our analogy with DLLs, early binding is similar to importing routines from a DLL by using the external directive. When you do that, you embed in your client the definition of those routines and you expect them to match exactly that definition when you connect to them at runtime. If the name, the parameters or the result type is changed, you will have an error as soon as the application starts. Late binding instead is similar to the GetProcAddress API call, where you specify the name of the function you want to connect to using a string and you get back a pointer to it. When you do that, your client runs fine unless you try to use that function passing wrong parameters. Invoking methods of a COM object through early binding is faster than doing it using late binding. Every time you use late binding, you are asking Windows to look for a method called with a certain name, return a pointer to it and then, finally, invoke it. By using early binding you immediately call it, without any additional overhead because you already know where that method's entry point is. On the other side instead, using late binding allows much more flexibility and make things such as scripting possible. This is the content of the file VBTest.vbs contained in the WordProcessor directory:

dim MyObj, i, s

set MyObj = CreateObject("COMConverter.ConverterList")
s = ""
for i = 0 to (MyObj.Count - 1)
  s = s & MyObj.Items(i).Description & ", "

next

msgbox("You can save as " & s)

Double click on it and see what happens. Our ConverterList object will be created and the names of all supported converters will be displayed. All this without Delphi, VB or anything else. This is done using a late bound call to the methods Get_Items and Get_Count. The Active Scripting Engine embedded in Windows (which, by the way is also accessible through COM) took care of parsing the text file and asking to find and invoke them. You can do the same in Delphi too but how do you make sure you are using one instead of the other? It is very easy. The way you can do late binding in Delphi is generally by using OleVariant variables. By using typed variables you are using early binding. This is a snippet of code from the unit fMainForm.pas in the WordProcessor directory:

implementation

uses ComObj;

{$R *.DFM}

procedure TForm1.bLateBindingClick(Sender: TObject);
var
  myobj: OleVariant;
begin
  myobj := CreateOLEObject('COMCOnverter.ConverterList');
  ShowMessage('There are ' + IntToStr(myobj.Count) + ' converters available');
end;

procedure TForm1.bEarlyBindingClick(Sender: TObject);
var
  myobj: IConverterList;
begin
  myobj := CoConverterList.Create;
  ShowMessage('There are ' + IntToStr(myobj.Count) + ' converters available');
end;

As you can see, the only differences between the two are the type of myobj and the instantiation of it. The fact that you declared myobj as an OleVariant is the key here. That tells Delphi how you invoke the methods of a COM object. Anytime you use an OleVariant you can specify any method name. The compiler won't complain. Try putting myobj.XYZ in the first event handler. Delphi will successfully compile it but at runtime will raise an exception as soon as you hit that line of code. Late binding . In the second case you wouldn't be able to compile it, because IConverterList doesn't define have a method called XYZ. Early binding .

Location independence

Not to many years ago the terms "distributed" and "thin client" became very popular. The two terms are often used together when discussing about systems physically split into presentation, business and data storage tiers (multi-tier or 3-tier systems). By physically split I mean that each of those tiers can be running on the same machine or on separate ones. The reasons behind this type or architecture have to do with both a need for cleaner designs and scalability. Since this is not an article about multi tier design, I won't go any deeper in this discussion. In the next articles on COM I will discuss about this topic in detail. The things we said so far showed how COM lets us use objects embedded in DLLs. Wouldn't be nice if, on top of that, those DLLs could be located and actually executed on a more powerful machine? Wouldn't be nice not to have to worry about TCP/IP communication and sockets? Well, this is all possible using distributed COM (DCOM). DCOM is an extension of COM that allows us to do inter process communication across machine boundaries. The real nice thing behind DCOM is that the only thing that changes for the developer is the way you instantiate your COM object. Instead of calling CoCreate you would now call CoCreateRemote() passing either an IP address or the name of the machine that executes the COM object. When you do this, Windows creates an object (proxy) on the client machine that looks exactly like the real object. When you call a method on the proxy, it takes care of delivering your call and the parameters you specified to the other machine where a listener (stub) is waiting. The stub then invokes the real method and packages back the result. All this is done transparently for you. Code wise, the only thing difference for you is to specify CoCreate or CoCreateRemote when creating your COM object.

Conclusion

COM is the ideal technology to develop flexible, expandable and open application on Windows. It defines a standard, object oriented way of exposing functionality and promotes integration between them. By embracing COM you can make your application more open, expandable and controllable (whenever needed) from the outside world. You will get access to a wide set of tools and functionality embedded in your operating system and other applications such as Microsoft Office which will enanche the functionality you can provide. If you need to develop enterprise systems you will be able to leverage your investment in this technology and get access to another set of tools and servers (i.e. Microsoft Transaction Server, BizTalk, Application Center) that won't require a switch in language or approach. If you were not familiar with COM, I hope this article provided some interesting information to get you started. If instead, you are already using COM, I hope it helped you understanding a little better why COM exists and when you can benefit from using it. Understanding the reasons behind a technology instead of jumping immediately into some step- by-step code example is a much more rewarding approach in both short and long run.

What's coming next...

COM is a very large topic. ActiveX, OLE, OLE/DB, ADO, MTS and other acronyms have been created to separate the COM world into smaller, specific areas or categories. COM has to do with networking, security, data storage and many, many other things... Many books have been written on these topics but still COM is considered very complex or obscure. Well, COM is everything but very complex or obscure. It is all about finding the right information at the right time. The key is understanding the whats and whys behind it as in any other technology. In the next articles I will try to get a little more technical and I will go into real code. I will also write other generic articles like this before approaching any of the sub categories mentioned above but I will try to keep a balance between theoretical and practical.

Resources

If you want to read more I recommend the following books:

Understanding COM+, David Platt, Microsoft Press
Inside COM, Dale Rogerson, Microsoft Press
COM and DCOM: Microsoft's Vision for Distributed Objects, Roger Sessions, John Wiley Sons

You may find some more informations online at:

Microsoft's COM pages
Binh Ly's website
Dan Miser's Distribucon site
Deborah Pate's "Rudimentary" home page

How to do an auto-splash screen with progression

Problem/Question/Abstract:

A convenience forms auto-creation while showing progression on application start.

Answer:

{
///////////////////////////////////////////////////////////////////////////////
                            Auto splash form class
///////////////////////////////////////////////////////////////////////////////
USE : Replace the Delphi standard form creation (Application.CreateForm) by

      with TfmToolsAutoSplash.Create(nil) do
        try
          Add('Data Module', TdmMain, dmMain, 100);
          Add('Main Form',   TfmMain, fmMain, 100);
          Add('Log',         TfmLog,  fmLog,  100);
          Execute;
        finally
          Free;
        end;
///////////////////////////////////////////////////////////////////////////////
}

unit F_TOOLS_AutoSplash;

// ############################################################################

interface

uses
  Forms, Controls, StdCtrls, Classes, ExtCtrls, ComCtrls;

const
  SPLASH_STEP_CAPTION: string = 'Creating : ';
  SPLASH_INITIALIZATION_CAPTION: string = 'Initialization...';
  SPLASH_FINALISATION_CAPTION: string = 'Finalization...';

type
  TfmToolsAutoSplash = class(TForm)
    pn1: TPanel;
    pn2: TPanel;
    pn3: TPanel;
    lbTitle: TLabel;
    lbVersion: TLabel;
    lbCopyright: TLabel;
    lbStep: TLabel;
    prgbStep: TProgressBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FFormsList: TCollection;
  protected
    procedure DoStep(ALabel: string; ADelay: integer); virtual;
  public
    procedure Clear;
    procedure Add(Caption: string; FormClass: TComponentClass; var Ref; Delay: integer
      = 250);
    procedure Execute;
  end;

  // ############################################################################

implementation

uses
  Windows, SysUtils, Dialogs;

{$R *.DFM}

type
  TSplashFormPtr = ^TForm;

  TSplashFormAllocItem = class(TCollectionItem)
  protected
    Text: string;
    InstanceClass: TComponentClass;
    Reference: TSplashFormPtr;
    Tempo: integer;
  end;

  //----------------------------------------------------------------------
  // TfmToolsAutoSplash.FormCreate
  //----------------------------------------------------------------------

procedure TfmToolsAutoSplash.FormCreate(Sender: TObject);
begin
  FFormsList := TCollection.Create(TSplashFormAllocItem);
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.FormDestroy
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.FormDestroy(Sender: TObject);
begin
  FFormsList.Free;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Clear
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Clear;
begin
  FFormsList.Clear;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Add
//----------------------------------------------------------------------
// SPEC : Add a form in the list.
// IN   : Caption     -> Title, if '' then use classname
//        FormClass   -> Class
//        Ref         -> Reference
//        Delay -> Delay
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Add(Caption: string; FormClass: TComponentClass; var Ref;
  Delay: integer);
begin
  with (FFormsList.Add as TSplashFormAllocItem) do
  begin
    case (Caption = '') of
      True: Text := SPLASH_STEP_CAPTION + FormClass.ClassName;
      False: Text := SPLASH_STEP_CAPTION + Caption;
    end;
    InstanceClass := FormClass;
    Reference := @TForm(Ref);
    Tempo := Delay;
  end;
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.DoStep
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.DoStep(ALabel: string; ADelay: integer);
begin
  prgbStep.StepIt;
  lbStep.Caption := ALabel;
  Refresh;
  Sleep(ADelay);
end;

//----------------------------------------------------------------------
// TfmToolsAutoSplash.Execute
//----------------------------------------------------------------------
// SPEC : Lance la cr�ation des feuilles.
//----------------------------------------------------------------------

procedure TfmToolsAutoSplash.Execute;
var
  i: integer;
begin
  prgbStep.Max := FFormsList.Count + 2;
  Show;
  DoStep(SPLASH_INITIALIZATION_CAPTION, 2);
  for i := 0 to FFormsList.Count - 1 do
    with (FFormsList.Items[i] as TSplashFormAllocItem) do
    begin
      DoStep(Text, Tempo);
      if (not Application.Terminated) then
        Application.CreateForm(InstanceClass, Reference^);
    end;
  DoStep(SPLASH_FINALISATION_CAPTION, 2);
end;

end.

How to reduce the window and GDI handles an application is using

Problem/Question/Abstract:

I am trying to reduce the resources required to run my application. My application was pulling available resources down to 44%. I moved a large section of code containing two graphs out of an "available" form that does not get dynamically created and freed, into a separate form that is called with application.formcreate() and then freed after use.

Answer:

Resources (the ones you can run out of in win9x) are things like window handles, menu handles, bitmap handles, handles of GDI objects like fonts, brushes, pens. These are not correlated with memory use or code size at all. All of these handles are used by Windows internally to reference some data structures for these objects (they are a kind of indirect pointer). The data structures are used by the 16 bit code that still makes up the core of Win9x/Me and come from a restricted pool of memory, a set of 64KByte memory blocks that are not extensible (the infamous USER and GDI heaps, USER and GDI are two of the core Windows modules).

The way to deal with resource-shortages is to reduce the number of window and GDI handles your app is using at any time. And the recipes for that are:

Do not autocreate your forms, with the exception of the main form. All other forms (at least the ones only used modally) should be created as needed and destroyed when no longer needed. Note that calling Close on a form will NOT destroy the forms memory image (and control handles), by default it only hides the form. For modeless forms you need a handler for the OnClose event of the form that sets the Action parameter to cafree. For modal forms you manually call the Free method of the form after the ShowModal call returned.
Try to replace controls that use Window handles with TGraphicControl descendents, e.g. TPanels and TGroupBoxes by TBevels. TGraphicControls do not use window handles, TWinControls do. Some, like TCombobox, even use more than one window handle.
If you use tabbed notebooks or pagecontrols a lot you can save resources by destroying the window handles of controls on hidden pages of the notebook, using the controls DestroyHandle method.
Replace groups of TEdit controls with a TStringGrid. A grid uses only two window handles, regardless how many cells it has.

How to change the colours of a bitmap that is loaded into a TImage

Problem/Question/Abstract:

How do I change the colors of a bitmap that is loaded into a TImage object? I have bitmaps that are displayed with a white background. I want to change all of the white pixels to black and all of the black pixels to white.

Answer:

Go over the picture with scanlines or whatever:

{ ... }
for x := 0 to width - 1 do
  for y := 0 to height - 1 do
  begin
    tc := img.canvas.pixels[x, y];
    if tc = clBlack then
      img.canvas.pixels[x, y] := clWhite;
    if tc = clWhite then
      img.canvas.pixels[x, y] := clBlack;
  end;

How to create all sorts of screen shots

Problem/Question/Abstract:

How to create all sorts of screen shots

Answer:

a) Copying the screen content into a form

Solve 1:

procedure TScrnFrm.GrabScreen;
var
  DeskTopDC: HDc;
  DeskTopCanvas: TCanvas;
  DeskTopRect: TRect;
begin
  DeskTopDC := GetWindowDC(GetDeskTopWindow);
  DeskTopCanvas := TCanvas.Create;
  DeskTopCanvas.Handle := DeskTopDC;
  DeskTopRect := Rect(0, 0, Screen.Width, Screen.Height);
  ScrnForm.Canvas.CopyRect(DeskTopRect, DeskTopCanvas, DeskTopRect);
  ReleaseDC(GetDeskTopWindow, DeskTopDC);
end;


Solve 2:

{ ... }
var
  Image1: TImage;
  { ... }

procedure TSaverForm.CopyScreen;
var
  DeskTopDC: HDC;
  DeskTopCanvas: TCanvas;
  DeskTopRect: TRect;
begin
  Image1 := TImage.Create(SaverForm);
  with Image1 do
  begin
    Height := Screen.Height;
    Width := Screen.Width;
  end;
  Image1.Canvas.copymode := cmSrcCopy;
  DeskTopDC := GetWindowDC(GetDeskTopWindow);
  DeskTopCanvas := TCanvas.Create;
  DeskTopCanvas.Handle := DeskTopDC;
  Image1.Canvas.CopyRect(Image1.Canvas.ClipRect, DeskTopCanvas, DeskTopCanvas.ClipRect);
  Image2.Picture.Assign(Image1.Picture);
  {image2 is on the saver form, aligned to client}
end;

procedure TSaverForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Image1.Free;
end;


b) Copying the screen content into a TImage

Create a form, drop a TImage control to the form, make it a decent size, and drop a button on it. DblClick the button and add the following code.

var
  ScreenDC: HDC;
begin
  ScreenDC := CreateDC('DISPLAY', nil, nil, nil);
  BitBlt(Image1.Canvas.Handle, 0, 0, Image1.Width, Image1.Height, ScreenDC, 0, 0, SRCCOPY);
  Image1.Refresh;
  DeleteDC(ScreenDC);
end;

That will copy the desktop into the Image Control. Play around with the 0,0 near the ScreenDC to move the TopLeft of the image to want to capture. Move your form around and click the button.


c) Copying the screen content into a bitmap

procedure ScreenShot(x: integer; y: integer; Width: integer; Height: integer; bm: TBitmap);
var
  dc: HDC;
  lpPal: PLOGPALETTE;
begin
  {test width and height}
  if ((Width < 1) or (Height < 1)) then
  begin
    exit;
  end;
  bm.Width := Width;
  bm.Height := Height;
  {get the screen dc}
  dc := GetDc(0);
  if (dc = 0) then
  begin
    exit;
  end;
  {do we have a palette device?}
  if (GetDeviceCaps(dc, RASTERCAPS) and RC_PALETTE = RC_PALETTE) then
  begin
    {allocate memory for a logical palette}
    GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
    {zero it out to be neat}
    FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
    {fill in the palette version}
    lpPal^.palVersion := $300;
    {grab the system palette entries}
    lpPal^.palNumEntries := GetSystemPaletteEntries(dc, 0, 256, lpPal^.palPalEntry);
    if (lpPal^.PalNumEntries <> 0) then
    begin
      {create the palette}
      bm.Palette := CreatePalette(lpPal^);
    end;
    FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
  end;
  {copy from the screen to the bitmap}
  BitBlt(bm.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);
  {release the screen dc}
  ReleaseDc(0, dc);
end;


d) Copying the screen content into a memory bitmap

{ ... }
var
  ScreenDC: HDC;
  fBitmap: TBitmap;
begin
  fBitmap := TBitmap.Create;
  fBitmap.Width := 100;
  fBitmap.Height := 100;
  ScreenDC := CreateDC('DISPLAY', nil, nil, nil);
  BitBlt(FBitmap.Canvas.Handle, 0, 0, FBitmap.Width, FBitmap.Height, ScreenDC, 0, 0, SRCCOPY);
  { You now have a copy of the screen from (0,0,100,100) in the fBitmap. You now can
  do what you want to it, merge it with another bitmap, or anything else you want to. }
  { Clean Up }
  DeleteDC(ScreenDC);
  fBitmap.Free
end;


e) Various screenshot procedures

unit Scrncap;

interface

uses
  WinTypes, WinProcs, Forms, Classes, Graphics;

function CaptureScreenRect(ARect: TRect): TBitmap;
function CaptureScreen: TBitmap;
function CaptureClientImage(Control: TControl): TBitmap;
function CaptureControlImage(Control: TControl): TBitmap;

implementation

{ Use this to capture a rectangle on the screen }

function CaptureScreenRect(ARect: TRect): TBitmap;
var
  ScreenDC: HDC;
begin
  Result := TBitmap.Create;
  with Result, ARect do
  begin
    Width := Right - Left;
    Height := Bottom - Top;
    ScreenDC := GetDC(0);
    try
      BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Left, Top, SRCCOPY);
    finally
      ReleaseDC(0, ScreenDC);
    end;
  end;
end;

{ Use this to capture the entire screen }

function CaptureScreen: TBitmap;
begin
  with Screen do
    Result := CaptureScreenRect(Rect(0, 0, Width, Height));
end;

{ Use this to capture just the client area of a form or control...}

function CaptureClientImage(Control: TControl): TBitmap;
begin
  with Control, Control.ClientOrigin do
    Result := CaptureScreenRect(Bounds(X, Y, ClientWidth, ClientHeight));
end;

{ Use this to capture an entire form or control  }

function CaptureControlImage(Control: TControl): TBitmap;
begin
  with Control do
    if Parent = nil then
      Result := CaptureScreenRect(Bounds(Left, Top, Width, Height))
    else
      with Parent.ClientToScreen(Point(Left, Top)) do
        Result := CaptureScreenRect(Bounds(X, Y, Width, Height));
end;

end.

How to change the size of the formatting rectangle of a TRichEdit

Problem/Question/Abstract:

On a TRichEdit component a line can be selected by moving the cursor to the very left of the line (the cursor will change to a right pointing arrow) and click the mouse. It seems that the position of the cursor must be in the left most pixel (i.e. only one pixel wide) so is often difficult to use. I would like to extend this functionality to be available for the full width of the border, but I cannot find out where this functionality is implemented. It is not available on the TMemo component so I presume it must be implemented in the TCustomRichEdit component but I can't find it. Can some please point me in the right direction or any suggestions on how to extend this functionality to be applied to the full border width.

Answer:

First, the width of the area where the TRichEdit control allows you to select a whole line is defined by the formatting rectangle of the control. The difference between ClientRect left and formatting rectangle left coordinates normally is 1 pixel, but you can move the left side of the formatting rectangle and the area where the cursor changes to a right pointing arrow and the RichEdit allows to select a line would be wider. You can do it both in the form OnCreate event and in the code of a TRichEdit descendant.

{ ... }
var
  XRect: TRect;
begin
  SendMessage(MyRichEdit1.Handle, EM_GETRECT, 0, integer(@XRect));
  XRect.Left := XRect.Left + 10; {set new left border for formatting rectangle}
  SendMessage(MyRichEdit1.Handle, EM_SETRECT, 0, integer(@XRect));
  { ... }

Regarding the selection of a whole line by clicking on the border, you should respond to the WM_NCHITTEST message and return a HTCLIENT constant in the message result in case the cursor is over border. The example below is a TRichEdit which has a LeftIndent property. By selecting it, you can set the left side of the formatting rectangle of the TRichEdit control.

{ ... }
TMyRichEdit = class(TRichEdit)
protected
  FLeftIndent: integer;
  procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  procedure SetEditRect;
  procedure SetLeftIndent(AValue: integer);
public
  constructor Create(AOwner: TComponent); override;
published
  property LeftIndent: integer read FLeftIndent write SetLeftIndent;
end;

{ ... }

constructor TMyRichEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLeftIndent := 0;
end;

procedure TMyRichEdit.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;
  if (Message.Result = HTBORDER) then
    Message.Result := HTCLIENT;
end;

procedure TMyRichEdit.SetEditRect;
var
  XRect: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, integer(@XRect));
  XRect.Left := FLeftIndent;
  SendMessage(Handle, EM_SETRECT, 0, integer(@XRect));
end;

procedure TMyRichEdit.SetLeftIndent(AValue: integer);
begin
  if FLeftIndent <> AValue then
  begin
    FLeftIndent := AValue;
    SetEditRect;
  end;
end;

How to send a pageup or pagedown to a TListBox

Problem/Question/Abstract:

I would like to control the pageup event of a TListBox by listbox1keydown(self,vk_next,[]); , but it produces an error message. Why?

Answer:

Calling the onKeyDown event handler directly accomplishes nothing. To make the control scroll you have to send either the key or a scroll message to the control itself. For the key that would take the following form:


procedure PostKey(hWindow: HWND; key: Word);
begin
  if IsWindow(hWindow) then
  begin
    PostMessage(hWindow, WM_KEYDOWN, key, MakeLong(0, MapVirtualKey(key, 0)));
    PostMessage(hWindow, WM_KEYUP, key, MakeLong(0, MapVirtualKey(key, 0) or $C0000000));
  end;
end;

PostKey(listbox.handle, VK_NEXT);

Since PostKey puts the messages into the message loop they will not get processed unless your code falls back to the message loop or calls Application.ProcessMessages. You could replace the PostMessage with a SendMessage in this case since the key yields no character.

Sending a scroll message directly would look like this:

listbox.perform(WM_VSCROLL, SB_PAGEDOWN, 0);
listbox.perform(WM_VSCROLL, SB_ENDSCROLL, 0);

How to fade in/out an image

Problem/Question/Abstract:

How to fade in/out an image?

Answer:

// Stores the colors //
type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..32767] of TRGBTriple;

  /////////////
  // Fade In //
  /////////////

procedure FadeIn(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit; // or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 0 to 32 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap); // Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

//////////////
// Fade Out //
//////////////

procedure FadeOut(ImageFileName: TFileName);
var
  Bitmap, BaseBitmap: TBitmap;
  Row, BaseRow: PRGBTripleArray;
  x, y, step: integer;
begin
  // Preparing the Bitmap //
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit; // or pf24bit //
    Bitmap.LoadFromFile(ImageFileName);
    BaseBitmap := TBitmap.Create;
    try
      BaseBitmap.PixelFormat := pf32bit;
      BaseBitmap.Assign(Bitmap);
      // Fading //
      for step := 32 downto 0 do
      begin
        for y := 0 to (Bitmap.Height - 1) do
        begin
          BaseRow := BaseBitmap.Scanline[y];
          // Getting colors from final image //
          Row := Bitmap.Scanline[y];
          // Colors from the image as it is now //
          for x := 0 to (Bitmap.Width - 1) do
          begin
            Row[x].rgbtRed := (step * BaseRow[x].rgbtRed) shr 5;
            Row[x].rgbtGreen := (step * BaseRow[x].rgbtGreen) shr 5; // Fading //
            Row[x].rgbtBlue := (step * BaseRow[x].rgbtBlue) shr 5;
          end;
        end;
        Form1.Canvas.Draw(0, 0, Bitmap); // Output new image //
        InvalidateRect(Form1.Handle, nil, False);
        // Redraw window //
        RedrawWindow(Form1.Handle, nil, 0, RDW_UPDATENOW);
      end;
    finally
      BaseBitmap.Free;
    end;
  finally
    Bitmap.Free;
  end;
end;

// You call the function like this

procedure TForm1.Button1Click(Sender: TObject);
begin
  FadeIn('C:\TestImage.bmp')
end;

How to control the scroll buffer of a TMemo

Problem/Question/Abstract:

I would like the TMemo object to have a 250 line scroll buffer. In other words, when the 251 line is added, the first line is removed from the TMemo object. Is there a way to accomplish this without having to copy each string from index n to index n - 1 each time the 250th line is added?

Answer:

You can use TStrings' Delete method and pass the index to it.

if memo1.Lines.Count = 251 then
  Memo1.lines.Delete(0);