lummie.co.uk

So, you're changing your packages and splitting them up nicely into a runtime and
design time package.  You create a new Component Registration unit and add
a register procedure, compile it all up and the register procedure never gets called
and the components are not registered……

Oh, how many times has this happened to me ? 

I finally worked out what was wrong.  Not being a copy and paste guy, I typed
in the register procedure and didn't capitalise the 'R'.  Therefore the entry
point to the DLL is never found !  Oh those case-sensitive C programmers have
a lot to answer for.

Please ensure the procedure Register is the correct case 🙂

The following code provides a routine for combining an image and a mask image into
an image with Alpha information.

The routine uses the GDI+ bitmap's Lockbits method to provide fast access to the
image data.

This routine is available in the GDIPExtensions unit which is part of GDI+ Controls.

function CombineImageMask(Bitmap: TGPBitmap; Mask: TGPBitmap; var AlphaRGBImage: TGPBitmap): boolean;
var
  w, h: cardinal;
  x, y: cardinal;
  obmd: TBitmapData;
  bbmd: TBitmapData;
  mbmd: TBitmapData;
  r: TGPRect;
  oImageStart: PByteArray;
  opixelpos: integer;
  oPixel: pARGB;
  bImageStart
    : PByteArray;
  bpixelpos: integer;
  bPixel: pARGB;
  mImageStart: PByteArray;
  mpixelpos
    : integer;
  mPixel: pARGB;
  alphalevel: cardinal;
begin
  AlphaRGBImage := nil;
  if not assigned(Bitmap) then
    raise EImageProcessError.create('No Bitmap assigned');
  if
    not assigned(Mask) then
    raise EImageProcessError.create('No Mask assigned');
  if (Bitmap.GetWidth = 0) or (Bitmap.GetHeight = 0) then
    raise
      EImageProcessError.create('Height and width of image must be greater than zero');
  if (Bitmap.GetWidth <> Mask.GetWidth)
    or (Bitmap.GetHeight <> Mask.GetWidth) then
    raise
      EImageProcessError.create('The hieght and width of both the image and mask should be the same');
  w := Bitmap.GetWidth;
  h := Bitmap.GetHeight;
  AlphaRGBImage := TGPBitmap.Create(w, h, PixelFormat32bppARGB);
  r := MakeRect(0, 0, integer(w), integer(h));
  bitmap.LockBits(r, ImageLockModeRead, PixelFormat32bppRGB, bbmd);
  mask.LockBits(r, ImageLockModeRead, PixelFormat32bppRGB, mbmd);
  AlphaRGBImage.LockBits(r, ImageLockModeWrite, PixelFormat32bppARGB, obmd);
  bImageStart := bbmd.Scan0;
  mImageStart := mbmd.Scan0;
  oImageStart := obmd.Scan0;
  for y := 0 to obmd.Height - 1 do
  begin
    for x := 0 to obmd.Width - 1 do
    begin
      opixelpos := (y * cardinal(obmd.Stride)) +
        (x * 4);
      oPixel := @oImageStart[oPixelPos];
      bpixelpos := (y * cardinal(bbmd.Stride))
        + (x * 4);
      bPixel := @bImageStart[bPixelPos];
      mpixelpos := (y * cardinal(mbmd.Stride))
        + (x * 4);
      mPixel := @mImageStart[mPixelPos];
      oPixel^ := bPixel^ and not ALPHA_MASK; // copy rgb
      across alphalevel := (((mpixel^ and $FF0000) shr 16) + ((mpixel^ and
        $00FF00) shr 8) + (mpixel^ and $0000FF)) div 3;
      oPixel^ := ((alphalevel and $FF) shl ALPHA_SHIFT) or oPixel^;
    end;
  end;
  AlphaRGBImage.UnlockBits(obmd);
  bitmap.UnlockBits(bbmd);
  mask.UnlockBits(mbmd);
  result := true;
end;

The following code provides a routine for fading out an area of an image. 
The routine uses the GDI+ bitmap's Lockbits method to provide fast access to the
image data.

It takes an Image and a Rectangle to fade out as parameters, A Fade Direction which
can be up, down, left or right and a fade type.  Currently this is can only
be linear, but alternative fade types could be implemented for example to provide
a circular fade.

This routine is available in the GDIPExtensions unit which is part of GDI+ Controls.

type TFadeDirection
    = (fdUp, fdDown, fdLeft, fdRight); TFadeType = (ftLinear); EImageProcessError =
    exception;




function
    FadeOut(Image : TGPBitmap; ARect :TGPRect; Direction : TFadeDirection; FadeType
    : TFadeType) : boolean; var
    x,y : integer; bmd : TBitmapData; ImageStart : integer;
        pixelpos : integer; Pixel : pARGB; AlphaChange : Double; CurrentAlpha, NewAlpha
        : Cardinal; begin
     if not assigned(Image) then raise EImageProcessError.create('No Image assigned');
    if
        (Image.GetWidth = 0) or (Image.GetHeight =
                    0)
                        then
                            raise EImageProcessError.create('Height and width of image must be greater
                                    than zero');
    if
        (Arect.Width = 0) or (ARect.Height =
                    0)
                        then
                            raise EImageProcessError.create('Height and width of Rectangle must be greater
                                    than zero'); Image.LockBits(Arect, ImageLockModeWrite,
                                        PixelFormat32bppARGB, bmd); assert(bmd.PixelFormat = PixelFormat32bppARGB); ImageStart
                                        := integer(bmd.Scan0); for y := 0 to bmd.Height
    do
         begin AlphaChange :=
                1;
                    case FadeType
                        of ftLinear :
    begin
         case
            Direction of
    fdDown : AlphaChange := 1-(y +
            1) / ARect.Height; fdUp
                : AlphaChange := (y + 1) / ARect.Height;
                        end;
                            end;
    end;
    for
        x := 0 to bmd.Width do
                 begin
                 case FadeType of
                    ftLinear :
                        begin  case Direction of
                            fdLeft : AlphaChange := (x +
    1)
        / ARect.Width; fdRight : AlphaChange :=
            1-(x + 1) / ARect.Width;
    end;
    end;
    end;
        Pixel := pARGB(ptr(ImageStart + (y * bmd.stride) +(x*4))); CurrentAlpha := (Pixel^
            and
                ALPHA_MASK) shr ALPHA_SHIFT; NewAlpha := trunc(CurrentAlpha * AlphaChange);
                    Pixel^ := (NewAlpha shl ALPHA_SHIFT) or (Pixel^ and not ALPHA_MASK); end; end; Image.UnlockBits(bmd); result := true;
    end;
 

This article was posted on Delphi 3000, and looked
so usefull for future reference I thought I'd post a copy.
Please note this article was authored by Mike Heydon
(mheydon at pgbison.co.za).

n article #4388 Radikal Q3 demonstrates how to set
the IP Address,Subnet and Gateway of a network card by EXECUTING NETSH.EXE with
parameters. This example shows how to do it via the WMI API OLE Classes. If IP ADDRESS
is NULLSTR or 'DHCP' then the IP Address is set by DHCP else a STATIC IP Address
is set.

Parameters are ..

AIpAddress – If Null String or 'DHCP' then DHCP is ENABLED     else STATIC
IP is set.

AGateWay   – [Optional] If Omitted then GATEWAY is left unchanged.

SubnetMask – [Optional] If Omited then default = '255.255.255.0'.

Examples

if SetIpConfig('196.11.175.221') = 0 then … // Set STATIC IP
if SetIpConfig('') = 0 then ..    // Set to DHCP
if SetupConfig('dhcp') = 0 then … // Same as above
if SetIpConfig('196.11.175.221','196.11.175.1') = 0 then ..  // STATIC + GATEWAY

**** THERE IS HOWEVER ONE PROBLEM I HAVE ******
**** AND HOPE SOMEONE OUT THERE CAN HELP ******

When setting the adapter to DHCP ALL Mapped drives and printers work correctly as
expected.

When setting the adapter to STATIC IP, the IP changes successfully but any mapped
devices (drives,printers etc.) won't work. Trying to access a mapped drives gives
error saying the "local device is already in use'. I don't know if you have to call
some sort of network mapping refresh call or something to notify that a static IP
address has changed ? Anyone out there have any ideas ?

Also shown is SetDnsServers() whereby the DNS Primary and Alternate Servsers may
be specified. If the function is called with Null String for APrimaryDNS then the
DNS list is cleared.

There are many things you can do once you get the oNetAdapter Object.
See
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/wmi_tasks__networking.asp
for the help on the SDK.

uses ComObj, ActiveX, UrlMon;

// ======================================================================
// SetIpConfig()
// Set IPAddress, Gateway and Subnetmask via WMI
// Arguments ...
// AIpAddress - If Null String or 'DHCP' then DHCP is ENABLED
//              else STATIC IP is set.
// AGateWay   - [Optional] If Omitted then GATEWAY is left unchanged.
// SubnetMask - [Optional] If Omited then default = '255.255.255.0'.
//
// SetDnsServers()
// Set  DNS Servers via WMI
// Arguments ...
// APrimaryDNS   - If Null String then DNS Server List is CLEARED.
// AAlternateDNS - [Optional]
//
// Return Values ...
//   0 Successful completion, no reboot required.
//   1 Successful completion, reboot required.
//  -1 Unknown OLE Error
//  64 Method not supported on this platform.
//  65 Unknown failure.
//  66 Invalid subnet mask.
//  67 An error occurred while processing an instance that was returned.
//  68 Invalid input parameter.
//  69 More than five gateways specified.
//  70 Invalid IP address.
//  71 Invalid gateway IP address.
//  72 An error occurred while accessing the registry for the info.
//  73 Invalid domain name.
//  74 Invalid host name.
//  75 No primary or secondary WINS server defined.
//  76 Invalid file.
//  77 Invalid system path.
//  78 File copy failed.
//  79 Invalid security parameter.
//  80 Unable to configure TCP/IP service.
//  81 Unable to configure DHCP service.
//  82 Unable to renew DHCP lease.
//  83 Unable to release DHCP lease.
//  84 IP not enabled on adapter.
//  85 IPX not enabled on adapter.
//  86 Frame/network number bounds error.
//  87 Invalid frame type.
//  88 Invalid network number.
//  89 Duplicate network number.
//  90 Parameter out of bounds.
//  91 Access denied.
//  92 Out of memory.
//  93 Already exists.
//  94 Path, file, or object not found.
//  95 Unable to notify service.
//  96 Unable to notify DNS service.
//  97 Interface not configurable.
//  98 Not all DHCP leases could be released or renewed.
//  100 DHCP not enabled on adapter.
// ======================================================================


// ==================================================================
// IP Address,Gateway and Subnet Mask
// EnableStatic takes array of string as a parameter
// for the Addresses. You may wish to rewrite this using
// array of string as parameter for multiple IP Addresses.
// I only have use for 1 IP address and Gateway in our application
// but it's nice to be able to expand it for other users.
// ==================================================================

function SetIpConfig(const AIpAddress : string;
                     const AGateWay : string = '';
                     const ASubnetMask : string = '') : integer;
var Retvar : integer;
    oBindObj : IDispatch;
    oNetAdapters,oNetAdapter,
    oIpAddress,oGateWay,
    oWMIService,oSubnetMask : OleVariant;
    i,iValue : longword;
    oEnum : IEnumvariant;
    oCtx : IBindCtx;
    oMk : IMoniker;
    sFileObj : widestring;
begin
  Retvar := 0;
  sFileObj := 'winmgmts:.rootcimv2';

  // Create OLE [IN} Parameters
  oIpAddress := VarArrayCreate([1,1],varOleStr);
  oIpAddress[1] := AIpAddress;
  oGateWay := VarArrayCreate([1,1],varOleStr);
  oGateWay[1] := AGateWay;
  oSubnetMask := VarArrayCreate([1,1],varOleStr);
  if ASubnetMask = '' then
    oSubnetMask[1] := '255.255.255.0'
  else
    oSubnetMask[1] := ASubnetMask;

  // Connect to WMI - Emulate API GetObject()
  OleCheck(CreateBindCtx(0,oCtx));
  OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
  OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
  oWMIService := oBindObj;

  oNetAdapters := oWMIService.ExecQuery('Select * from ' +
                                        'Win32_NetworkAdapterConfiguration ' +
                                        'where IPEnabled=TRUE');
  oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

  while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
    try
      // Set by DHCP ? (Gateway and Subnet ignored)
      if (AIpAddress = '') or SameText(AIpAddress,'DHCP') then
        Retvar := oNetAdapter.EnableDHCP
      // Set via STATIC ?
      else begin
        Retvar := oNetAdapter.EnableStatic(oIpAddress,oSubnetMask);
        // Change Gateway ?
        if (Retvar = 0) and (AGateWay <> '') then
          Retvar := oNetAdapter.SetGateways(oGateway);

        // *** This is where we need some sort of ***
        // *** Network Mapped Resource Refresh    ***
      end;
    except
      Retvar := -1;
    end;

    oNetAdapter := Unassigned;
  end;

  oGateWay := Unassigned;
  oSubnetMask := Unassigned;
  oIpAddress := Unassigned;
  oNetAdapters := Unassigned;
  oWMIService := Unassigned;
  Result := Retvar;
end;


// ====================================================
// Set DNS Servers
// Instead of Primary and Alternate you may wish
// to rewrite this using array of string as the
// parameters as SetDNSServerSearchOrder will take
// a list of many DNS addresses. I only have use for
// Primary and Alternate.
// ====================================================

function SetDnsServers(const APrimaryDNS : string;
                       const AAlternateDNS : string = '') : integer;
var Retvar : integer;
    oBindObj : IDispatch;
    oNetAdapters,oNetAdapter,
    oDnsAddr,oWMIService : OleVariant;
    i,iValue,iSize : longword;
    oEnum : IEnumvariant;
    oCtx : IBindCtx;
    oMk : IMoniker;
    sFileObj : widestring;
begin
  Retvar := 0;
  sFileObj := 'winmgmts:.rootcimv2';
  iSize := 0;
  if APrimaryDNS <> '' then inc(iSize);
  if AAlternateDNS <> '' then inc(iSize);

  // Create OLE [IN} Parameters
  if iSize > 0 then begin
   oDnsAddr := VarArrayCreate([1,iSize],varOleStr);
   oDnsAddr[1] := APrimaryDNS;
   if iSize > 1 then oDnsAddr[2] := AAlternateDNS;
  end;

  // Connect to WMI - Emulate API GetObject()
  OleCheck(CreateBindCtx(0,oCtx));
  OleCheck(MkParseDisplayNameEx(oCtx,PWideChar(sFileObj),i,oMk));
  OleCheck(oMk.BindToObject(oCtx,nil,IUnknown,oBindObj));
  oWMIService := oBindObj;

  oNetAdapters := oWMIService.ExecQuery('Select * from ' +
                                        'Win32_NetworkAdapterConfiguration ' +
                                        'where IPEnabled=TRUE');
  oEnum := IUnknown(oNetAdapters._NewEnum) as IEnumVariant;

  while oEnum.Next(1,oNetAdapter,iValue) = 0 do begin
    try
      if iSize > 0 then
        Retvar := oNetAdapter.SetDNSServerSearchOrder(oDnsAddr)
      else
        Retvar := oNetAdapter.SetDNSServerSearchOrder();
    except
      Retvar := -1;
    end;

    oNetAdapter := Unassigned;
  end;

  oDnsAddr := Unassigned;
  oNetAdapters := Unassigned;
  oWMIService := Unassigned;
  Result := Retvar;
end;



(* ----------------------------------------------------
See the Miscrosoft MSDN Documentation for the
Win32_NetworkAdapterConfiguration Class
(implemented as oNetAdatper in my examples),
There are many more calls besides EnableStatic,
EnableDHCP and SetDNBSServerSearchOrder.

Some of them are ...

DisableIPSec
EnableDHCP
EnableDNS
EnableIPFilterSec
EnableIPSec
EnableStatic
EnableWINS
ReleaseDHCPLease
ReleaseDHCPLeaseAll
RenewDHCPLease
RenewDHCPLeaseAll
SetArpAlwaysSourceRoute
SetArpUseEtherSNAP
SetDatabasePath
SetDeadGWDetect
SetDefaultTTL
SetDNSDomain
SetDNSServerSearchOrder
SetDNSSuffixSearchOrder
SetDynamicDNSRegistration
SetForwardBufferMemory Specifies
SetGateways
SetIGMPLevel
SetIPConnectionMetric
SetIPUseZeroBroadcast
SetIPXFrameTypeNetworkPairs
SetIPXVirtualNetworkNumber
SetKeepAliveInterval
SetKeepAliveTime
SetNumForwardPackets
SetPMTUBHDetect
SetPMTUDiscovery
SetTcpipNetbios
SetTcpMaxConnectRetransmissions
SetTcpMaxDataRetransmissions
SetTcpNumConnections
SetTcpUseRFC1122UrgentPointer
SetTcpWindowSize
SetWINSServer
------------------------------------------------ *)

If you want to add html pages or images to your dll
or exe in delphi it is a simple matter of adding the pages as resources. This article
covers adding html and image files to the resource, and how to pass infromation
to the html file to make it a bit more dynamic.

Stage 1) How do we add an image or
html document to a exe or dll.

Create a file in the project directory (e.g. called MyProjectRes.rc). The easiest
application to create this in is notepad, you can create it in delphi, but make
sure the extension is .rc.

Choose Project->Add To Project… then change the Files of Type to Resource File
(*.rc), select the .rc file (e.g. MyProjectRes.rc) and choose Open.

In the RC file we can add lines that define the resource to include. These are of
the format :

[Resource Name][Space or Tab][Resource Type][Space or Tab][Filename of resource]

e.g 
PICTURE1 GIF ".ImagesMyImage.gif"

Delphi should have automatically added a line into the project source (e.g.
{$R 'HTMLResources.res' 'HTMLResources.rc'}) so when the project is built it will
automatically compile the Resource script file (.rc) into a resource *.res.

You can now access these resources in code by using a TResourceStream or TBitmap.LoadFromResource
for example.

Stage 2) Specifying HTML resources and images.

If we used the above example of a resource (PICTURE1 GIF ".ImagesMyImage.gif")
then we can reference the resource via Internet Explorer as the URL

res://c:program%20filesmydll.dll/GIF/PICTURE1

The Url starts with the res:// followed by the path to the dll or exe with the resource
(using backslash not forward slash) then /[Resource Type]/[Resource Name]

If you wish to add a resource that can be accessed directly with out the need to
specify the Resource Type portion of the URL then you can add it as follows :

Name 2110 DISCARDABLE "path to file"

The type 2110 allows the resource to be referenced at the root of the url e.g.

res://c:program%20filesmydll.dll/Name

The discardable option means that if windows needs memory then this resource can
be release and only reloaded when needed.

Stage 3) Creating a dynamic HTML resource

It is possible, to use the querystring part of a URL to send parameters or information
to the HTML resource. To do this we use a bit of java script to extract the querystring
from the URL.

e.g. I created this Javascript function to extract text between # and ## 

function Homepage(){
  DocURL=document.location.href;
  BeginInfo=DocURL.indexOf("#")+1;
  EndInfo=DocURL.indexOf("##");
  urlresult=DocURL.substring(BeginInfo,EndInfo);
  document.write('' + unescape(urlresult) + "");
}

This is simply called a the the appropriate point to insert the querystring text
there.

Homepage();

I can the use a resource like res://c:program%20filesmydll.dll/error#My Message
to display##

Note in the JavaScript function the use of unesacpe to remove the %20 that IE puts
in instead of the spaces.

Images and other resources can be referenced as relative paths from the dll resource.

e.g

<img xsrc="GIF/ImageUnderGIFType" width="50" height="45"

or

<img xsrc="GIFAtRoot" width="50" height="45">

The following are what I personally
consider the essential 3rd part components and libraries that are need to build
a Delphi Application. You may well disagree, but this is what I have tended to
standardise on and have found useful.

Tnt Unicode Controls

You want your application to be used by as many
people as possible so lets make it store it's data as unicode and use a set of
components that support unicode perfectly. The Tnt Unicode controls provides
unicode versions of all the components found on Standard, Additional, Win32, and
Dialogs pallette tabs.

Tnt Controls can be found at http://www.tntware.com/delphicontrols/

Virtual Tree View

The VirtualTreeView controls, VirtualStringTree and
VirtualDrawTree provide the only tree control you'll need. Full Implemented in
Delphi, and developed over 3 years, this little baby is superb. It is unicode
compliant, integrates with the tntUnicode editors, and supports the virtual
paradigm so loading a tree up with a million nodes is no problem.

In
addition it is probably one of the most customisable controls you'll come
across, allowing you easily to override paint routines to provide the perfrect
presentation that you need. It should be noted also that there is an extremely
loyal and developled following of users of the VirtualTreeView and there are
some great resources and example applications on teh delphi-gems
site.

Virtual Tree View can be found at http://www.delphi-gems.com/VirtualTreeview/

TPNGImage

The TPNGImage units provide PNG reading and writing support
for Delphi. It integrates and registers iteself as a TGraphic descendant and
allows access to scanline and a scanline for the alpha transparency as
well.
This implementation can be a little slow at times if you are trying to
implement large png images with full alpha support, but it is exellent for
creating transparent forms with nice anti-aliased edges.
See my splash
screen article for a great use of the TPNGImage unit.

TPNGImage is
free, opensource and available from http://pngdelphi.sourceforge.net/

Turbopower Lockbox

LockBox is a cross-platform toolkit for data
encryption. It contains routines & components for use with Borland Delphi,
C++Builder, & Kylix. It provides support for Blowfish, RSA, MD5, SHA-1, DES,
triple- DES, Rijndael, & digital signing of messages. If you need to do
encryption or signing then these libraries are faast and free.

Lockbox is
opensource and available from http://sourceforge.net/projects/tplockbox/

Turbopower Abbrevia

Abbrevia is a compression toolkit for Borland
Delphi, C++Builder, & Kylix. It supports PKZIP 4, Microsoft CAB, TAR, &
gzip formats & the creation of self-extracting archives. It includes visual
components that simplify the manipulation of ZIP files.

Abbrevia is
opensource and is available from http://sourceforge.net/projects/tpabbrevia/

The following code provides a routine for splitting out a source image with an Alpha channel into two images, the first holding the RGB information and the second as a Grayscale mask image.
The routine uses the GDI+ bitmap’s Lockbits method to provide fast access to the image data.
This routine is available in the GDIPExtensions unit which is part of GDI+ Controls.

function SplitAlpha(Source: TGPBitmap; var Bitmap: TGPBitmap;
  var Mask: TGPBitmap): boolean;

  procedure SetGrayScale(palette: PColorPalette);
  var
    i: integer;
  begin
    for i := 0 to Palette.Count - 1 do
    begin
      palette.Entries[i] := MakeColor(i, i, i);
    end;
  end;
var
  SourcePixelFormat: PixelFormat;
  w, h: cardinal;
  x, y: cardinal;
  sbmd: TBitmapData;
  bbmd: TBitmapData;
  mbmd: TBitmapData;
  r: TGPRect;
  sImageStart: PByteArray;
  spixelpos
    : integer;
  sPixel: pARGB;
  bImageStart: PByteArray;
  bpixelpos: integer;
  bPixel: PRGBTriple;
  mImageStart: PByteArray;
  mpixelpos: integer;
  mPixel: pByte;
  Palette: pColorPalette;
  PaletteSize: cardinal;
begin
  Bitmap := nil;
  Mask := nil;
  if not assigned(Source) then raise EImageProcessError.create('No sourceimage assigned');
  if (source.GetWidth = 0) or (source.GetHeight = 0) then raise  EImageProcessError.create('Height and width of source image must be greater than zero');

  SourcePixelFormat := source.GetPixelFormat;
  if not IsAlphaPixelFormat(SourcePixelFormat) then raise EImageProcessError.create('Source image does not have alpha channel');

  w := Source.GetWidth;
  h := source.GetHeight;

  Bitmap := TGPBitmap.Create(w, h, PixelFormat32bppRGB);
  Mask := TGPBitmap.Create(w, h, PixelFormat8bppIndexed);

  PaletteSize := mask.GetPaletteSize;
  Palette := AllocMem(PaletteSize);

  mask.GetPalette(Palette, PaletteSize);
  SetGrayScale(Palette);
  mask.SetPalette(Palette);
  FreeMem(Palette, PaletteSize);

  r := MakeRect(0, 0, integer(w), integer(h));
  source.LockBits(r, ImageLockModeRead, PixelFormat32bppARGB, sbmd);
  bitmap.LockBits(r, ImageLockModeWrite, PixelFormat32bppRGB, bbmd);
  mask.LockBits(r, ImageLockModeWrite, PixelFormat8bppIndexed, mbmd);

  sImageStart := sbmd.Scan0;
  bImageStart := bbmd.Scan0;
  mImageStart := mbmd.Scan0;
  for y := 0 to sbmd.Height - 1 do
  begin
    for x := 0 to sbmd.Width - 1 do
    begin
      spixelpos := (y * cardinal(sbmd.Stride)) +
        (x * 4);
      sPixel := @sImageStart[sPixelPos];
      bpixelpos := (y * cardinal(bbmd.Stride))
        + (x * 4);
      bPixel := @bImageStart[bPixelPos];
      mpixelpos := (y * cardinal(mbmd.Stride))
        + (x);
      mPixel := @mImageStart[mPixelPos];
      bPixel.rgbtRed := (spixel^
        and
        $FF0000) shr 16;
      bPixel.rgbtGreen := (spixel^ and $00FF00)
        shr
        8;
      bPixel.rgbtBlue := (spixel^ and $0000FF);
      mpixel^ := (spixel^ and ALPHA_MASK)
        shr
        ALPHA_SHIFT;
    end;
  end;
  source.UnlockBits(sbmd);
  bitmap.UnlockBits(bbmd);
  mask.UnlockBits(mbmd);
  result := true;
end;