Custom drawing on glass (2)

In my previous post, I both introduced the topic of custom drawing on glass, and looked at basic bitmap drawing specifically. In this one, I’ll look in more detail at the other ‘classic GDI’ techniques I mentioned there, namely using icons, image lists, the theming API and brushes. I’ll also briefly look at generating custom bitmaps at runtime too.

Icons and image lists

If you want to draw to glass, you need 32 bit images, and one form these may take is that of the good old ICO format, which has supported 32 bit colour entries since Windows XP. As the VCL’s TIcon class is a fairly thin wrapper round the HICON API, it therefore essentially supports them by default. Vista also brought ‘large’ (i.e., 256×256 PNG encoded) icons, which TIcon – at least until XE according to QC86768 – didn’t reliably wrap however. If it works though, use of a 32 bit icon is pretty simple – first load it into a TIcon instance in the normal way, and then secondly draw it in the normal way, whether by calling Canvas.Draw or the DrawIconEx API function. Unlike the case of raw bitmaps, there’s no need to worry about pixel pre-multiplication.

One thing to watch out for, though, is how D2007’s TIcon at least can fail to report the icon size correctly for 32 bit colour icons. This then causes an issue with TImageList, since if you attempt to call TImageList’s AddIcon method when passing in a 32 bit icon, an exception is likely to be raised complaining that the icon is the wrong size.

As a matter of fact, this exception is completely unnecessary even when it is accurate, since TImageList merely wraps the HIMAGELIST API, and the HIMAGELIST API will internally resize copied icons as appropriate anyhow. Consequently, a quick and easy workaround for the bug is something like this [edit: see note at the end for an explanation]:

uses CommCtrl, Graphics, ImgList;

type
  TImageListAddIconFixer = class helper for TCustomImageList
  public
    function AddIcon(Image: TIcon): Integer;
  end;

function TImageListAddIconFixer.AddIcon(Image: TIcon): Integer;
begin
  if Image = nil then
    Result := Add(nil, nil)
  else
  begin
    Result := ImageList_AddIcon(Handle, Image.Handle);
    Change;
  end;
end;

With respect to image lists themselves, successfully loading 32 bit icons into one requires the image list to itself be 32 bit. This is only possible when Windows theming is enabled and used – even D2009 and above, which surfaces the functionality, does not abstract from this limitation, so you may find yourself needing two sets of image lists, one ‘best looking’ set for when theming is active and a regular 24 bit colour one for when it is not.

That caveat aside, creating a fresh 32 bit image list is quite simple – in D2009 or later, set a TImageList’s ColorDepth property to cd32bit. In D2007, you’ll have to call the ImageList_Create function directly, assigning the result to the Handle property of a TImageList instance:

uses CommCtrl;

with MyImageList do
Handle := ImageList_Create(Width, Height, ILC_COLOR32 or ILC_MASK, AllocBy, AllocBy)

Using 24 bit (or less) colour image lists

In practice – or at least, from the custom control writer’s point of view – the problem with image lists and glass will be less in creating 32 bit colour image lists, but in making use of lesser colour ones. In short, do nothing special, and you’ll be drawing images like this

24 bit image list, no workaround

when what you really want is this

24 bit image list with workaround

While it may be considered a bit simplistic, the best workaround, I suggest, is to simply draw to a temporary 32 bit bitmap first, manually set the alpha channel, then alpha blend the bitmap to the screen:

procedure ClearRGBQuad(var Q: TRGBQuad); inline;
begin
  LongWord(Q) := 0;
end;

function SameRGBQuad(const Q1, Q2: TRGBQuad): Boolean; inline;
begin
  Result := LongWord(Q1) = LongWord(Q2);
end;

procedure DrawImageListWithAlpha(ImageList: TCustomImageList; Canvas: TCanvas;
  DestX, DestY: Integer; ImageIndex: TImageIndex);
const
  MergeFunc: TBlendFunction = (BlendOp: AC_SRC_OVER; BlendFlags: 0;
  SourceConstantAlpha: 255; AlphaFormat: AC_SRC_ALPHA);
const
  TransPixel: TRGBQuad = (rgbBlue: $FE; rgbGreen: $00; rgbRed: $FF; rgbReserved: $00);
var
  Buffer: TBitmap;
  PixelPtr: PRGBQuad;
  X, Y: Integer;
begin
  {$IF DECLARED(cd32Bit)}
  if ImageList.ColorDepth = cd32Bit then
  begin
    ImageList.Draw(Canvas, DestX, DestY, ImageIndex, dsTransparent, itImage);
    Exit;
  end;
  {$IFEND}
  Buffer := TBitmap.Create;
  try
    Buffer.Canvas.Brush.Color := RGB(TransPixel.rgbRed,
      TransPixel.rgbGreen, TransPixel.rgbBlue);
    Buffer.PixelFormat := pf32bit;
    Buffer.SetSize(ImageList.Width, ImageList.Height);
    ImageList.Draw(Buffer.Canvas, 0, 0, ImageIndex, dsTransparent, itImage);
    for Y := Buffer.Height - 1 downto 0 do
    begin
      PixelPtr := Buffer.ScanLine[Y];
      for X := Buffer.Width - 1 downto 0 do
      begin
        if SameRGBQuad(PixelPtr^, TransPixel) then
          ClearRGBQuad(PixelPtr^)
        else
          PixelPtr.rgbReserved := $FF;
        Inc(PixelPtr);
      end;
    end;
    AlphaBlend(Canvas.Handle, DestX, DestY, ImageList.Width, ImageList.Height,
      Buffer.Canvas.Handle, 0, 0, ImageList.Width, ImageList.Height, MergeFunc)
  finally
    Buffer.Free;
  end;
end;

If you’re wondering, the values of TransPixel add up to a colour that is almost-but-not-quite clFushia, which I’ve chosen quite arbitrarily. Note too that the byte order of a TRGBQuad – which defines a single pixel in a 32 bit Windows bitmap – is different to the byte order of a GDI colour value (and therefore, TColor): confusingly enough, TRGBQuad has a byte order of blue-green-red-alpha, not red-green-blue-alpha.

Naturally, if you’re dealing with massive images, the approach taken above would be problematic. Given image lists typically contain only very small images though, it should work fine.

Theming API

In the main, the Windows theming API is helpfully wrapped by the ThemeServices singleton object in Themes.pas, though as always, you can always call it directly of course. If you want to understand its general use, check out the source for something like TSpeedButton or TBitBtn, which uses the theming API when available.

One important function that is probably not wrapped by Themes.pas, however, is DrawThemeTextEx. The significance of this function – which was introduced in Vista – is that it enables you to define an outlining ‘glow’ that is frequently necessary to make the drawn text readable on glass, especially when what is behind the form is dark –

Without glow

With glow

To make it easy to use, you might write a simple wrapper function like the following:

uses Types, UxTheme, Themes, Graphics;

procedure DrawGlassText(Canvas: TCanvas; GlowSize: Integer; var Rect: TRect;
  var Text: UnicodeString; Format: DWORD); overload;
var
  DTTOpts: TDTTOpts;
begin
  if Win32MajorVersion < 6 then
  begin
    DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Format);
    Exit;
  end;
  ZeroMemory(@DTTOpts, SizeOf(DTTOpts));
  DTTOpts.dwSize := SizeOf(DTTOpts);
  DTTOpts.dwFlags := DTT_COMPOSITED or DTT_TEXTCOLOR;
  if Format and DT_CALCRECT = DT_CALCRECT then
    DTTOpts.dwFlags := DTTOpts.dwFlags or DTT_CALCRECT;
  DTTOpts.crText := ColorToRGB(Canvas.Font.Color);
  if GlowSize > 0 then
  begin
    DTTOpts.dwFlags := DTTOpts.dwFlags or DTT_GLOWSIZE;
    DTTOpts.iGlowSize := GlowSize;
  end;
  with ThemeServices.GetElementDetails(teEditTextNormal) do
    DrawThemeTextEx(ThemeServices.Theme[teEdit], Canvas.Handle, Part, State,
      PWideChar(Text), Length(Text), Format, @Rect, DTTOpts);
end;

It would probably be sensible if Embarcadero added an overload of TCanvas.TextRect that calls DrawThemeTextEx, though especially if you define a wrapper like the above, it’s not difficult to use directly if you’re accustomed to the older DrawText API function.

Brushes

Simply put, TBrush by default will be alpha channel ignorant, making the FillRect and FrameRect methods of TCanvas useless when drawing to glass. However, by dint of Windows allowing a brush to be created from a device independent bitmap (DIB), it is in fact possible to create solid brushes that have an alpha channel. Annoyingly however, you can’t just use the Bitmap property of TBrush to set this up, since TBrush internally forceably converts any source bitmap to a device dependent one (DDB) – basically, when Delphi 1 was released, the Windows API only supported creating brushes from DDBs, and the VCL has never been updated to no longer adhere to this dead requirement. Because of this, you’ll need to dip into the using Windows API directly.

Once again though, that’s not too tricky once you know what exactly to call, which is the CreateDIBPatternBrushPt API function. To create a simple, alpha-aware brush, this function needs to be passed the definition of a 32 bit, 1×1 pixel DIB, as defined in a TBitmapInfo record. The result can then be assigned to the Handle property of a TBrush instance, or used directly if you prefer.

Similar to the case of calling the AlphaBlend API function however, the pixel so defined needs to be ‘premultiplied’, i.e., factored by the alpha channel value as a proportion of 100% solid. Putting this info all together leads to something like this:

function CreatePreMultipliedRGBQuad(Color: TColor; Alpha: Byte = $FF): TRGBQuad;
begin
  Color := ColorToRGB(Color);
  Result.rgbBlue := MulDiv(GetBValue(Color), Alpha, $FF);
  Result.rgbGreen := MulDiv(GetGValue(Color), Alpha, $FF);
  Result.rgbRed := MulDiv(GetRValue(Color), Alpha, $FF);
  Result.rgbReserved := Alpha;
end;

function CreateSolidBrushWithAlpha(Color: TColor; Alpha: Byte = $FF): HBRUSH;
var
  Info: TBitmapInfo;
begin
  FillChar(Info, SizeOf(Info), 0);
  Info.bmiHeader.biSize := SizeOf(Info.bmiHeader);
  Info.bmiHeader.biWidth := 1;
  Info.bmiHeader.biHeight := 1;
  Info.bmiHeader.biPlanes := 1;
  Info.bmiHeader.biBitCount := 32;
  Info.bmiHeader.biCompression := BI_RGB;
  Info.bmiColors[0] := CreatePreMultipliedRGBQuad(Color, Alpha);
  Result := CreateDIBPatternBrushPt(@Info, 0);
end;

CreateSolidBrushWithAlpha can then be used as thus:

procedure TfrmMain.pbxBrushesPaint(Sender: TObject);
var
  R: TRect;
begin
  R := pbxBrushes.ClientRect;
  with pbxBrushes.Canvas do
  begin
    Brush.Handle := CreateSolidBrushWithAlpha(clGray);
    FrameRect(R);
    InflateRect(R, -2, -2);
    Brush.Handle := CreateSolidBrushWithAlpha(clBlack);
    FrameRect(R);
    InflateRect(R, -1, -1);
    Brush.Handle := CreateSolidBrushWithAlpha(clRed, 100);
    FillRect(R);
  end;
end;

Try it out, and you should get something like this (pbxBrushes should be a TPaintBox, if you can’t guess):

Brushes example

Custom bitmap creation

One last thing to mention is that if you need a little more than boxes, you can always create a custom bitmap at runtime. The drill here is to create a TBitmap instance, set its PixelFormat property to pf32Bit, set its size, then use its ScanLine property to set its pixels as required. This can be a little bit tedious for sure, but it’s a useful option to have.

As an example, here is some code that fills a paint box (pbxScanLine) with a gradient that goes from transparent to solid blue. As only a simple linear gradient is required, a bitmap 1 pixel thick is created then stretched in the AlphaBlend call (please see above for the CreatePreMultipliedRGBQuad function):

type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..$FFFFFFF] of TRGBQuad;

procedure TfrmMain.pbxScanLinePaint(Sender: TObject);
const
  MergeFunc: TBlendFunction = (BlendOp: AC_SRC_OVER; BlendFlags: 0;
    SourceConstantAlpha: $FF; AlphaFormat: AC_SRC_ALPHA);
var
  Bitmap: TBitmap;
  Pixels: PRGBQuadArray;
  X: Integer;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(pbxScanLine.Width, 1);
    Pixels := Bitmap.ScanLine[0];
    for X := Bitmap.Width - 1 downto 0 do
      Pixels[X] := CreatePreMultipliedRGBQuad(clNavy, ($FF * X) div Pred(Bitmap.Width));
    Windows.AlphaBlend(pbxScanLine.Canvas.Handle, 0, 0, pbxScanLine.Width,
      pbxScanLine.Height, Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,
      MergeFunc);
  finally
    Bitmap.Free;
  end;
end;

That’s all for this post. I have however put up on CodeCentral a small demo that shows the various techniques discussed – download it from here.

[* Edit 29/1/11: I see this post has been referenced on StackOverflow regarding the first image list issue discussed (at my time of writing, I’m talking about the questioner’s own answer to this question). To be clear, the image list fixing code is a class helper, the idea being to include it in a unit that is then added to the uses clause of your main unit(s) after Controls and ImgList. If you’re using D7 or earlier, or simply dislike class helpers, you should just use ImageList_Add directly — the thought behind the class helper is simply to allow you to continue to use a TImageList entirely normally. In particular, in D7 or earlier, don’t change the class helper to a regular class and then use it by casting from a regular TImageList.]

Advertisements

4 thoughts on “Custom drawing on glass (2)

  1. A minor correction. You can use 32bpp alpha blended icons in image lists even when theming is not in use. You need comctl32 v6 so that means Win2k is out, but it works perfectly well in Windows classic XP, Vista, 7 etc.

  2. Great series of articles. Using this info I was finally able to do some custom form work. I had made it all “work” before, sort of. But this info really helped. Thanks

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s