Comments on: Alpha Blended Splash Screen in Delphi - Part 2

By: Moritz Both

Moritz Both — Mon, 17 Jan 2011 13:05:47 +0000

For me, this solution worked - without GDI+:

I copy the ARGB image to a temporary bitmap and draw text on this bitmap using normal Canvas methods. These methods, however, always draw transparent objects, so I set the alpha channel for all areas where I drew on the image to 255 afterwards. This works for me because the areas of the image where I put my text on are not transparent (it is a splash screen with transparent borders):

void TfrmSplash::updateWindow()
{
 
    Graphics::TBitmap *image = new Graphics::TBitmap();
    image->Assign(splashImage);
 
    image->Canvas->Font->Color = 0×666666;
    image->Canvas->Font->Size = 9;
    image->Canvas->Font->Name = "Tahoma";
    image->Canvas->Pen->Style = psSolid;
    image->Canvas->Brush->Style = bsClear;
    TSize txs = image->Canvas->TextExtent(line1);
    image->Canvas->TextOut((image->Width - txs.cx) / 2, 314, line1);
    setAlphaTo255(image, TRect(20, 314, image->Width-21, 332+txs.cy));
    PremultiplyBitmap(image);
    // … and action!
    UpdateLayeredWindow(Handle, 0, NULL, &BitmapSize, image->Canvas->Handle,
        &BitmapPos, 0, &BlendFunction, ULW_ALPHA);
    delete image;
}
 
void TfrmSplash::setAlphaTo255(Graphics::TBitmap *image, TRect &rect)
{
    for (int row = rect.Top; row < rect.Bottom; row++)
    {
        TRGBQuad *p = (TRGBQuad *)image->ScanLine[row];
        p += rect.Left;
        for (int col = rect.Left; col <= rect.Right; col++, p++)
            p->rgbReserved = 255;
    }
}

… thans for the great article, anyway.

By: Fredrik Vestin

Fredrik Vestin — Thu, 21 Oct 2010 08:38:29 +0000

Excellent article! Well written and to the point. It is a bit outdated though and I think more people could benefit if it was updated for Delphi 2010 etc. I Googled for quite some time before I found this article.
For example Embarcadero has now purchased to PNGImage source code and it is now included in the VCL from Delphi 2009 so there's no need for 3rd party libraries.
http://blogs.embarcadero.com/n...../13/39100/

By: Gintas

Gintas — Tue, 28 Sep 2010 18:12:18 +0000

Thanks for professional tutorial. It was really what I needed for my free desktop widgets engine.
You can download the Delphi TPNGImage from various sources. Like http://code.google.com/p/livreerp/downloads/list

By: David

David — Sun, 29 Aug 2010 14:34:41 +0000

Hi! I wonder if it is possible to use into a form with buttons? Thanks

By: r1weedee

r1weedee — Fri, 19 Mar 2010 17:58:03 +0000

Thanks, i really appreciate this tutorial.

By: Anders Melander

Anders Melander — Thu, 11 Mar 2010 14:11:22 +0000

I don't know what that has to do with the article you're commenting on but TImage and TPngImage support transparent PNGs just fine.

By: MJ

MJ — Thu, 11 Mar 2010 13:05:48 +0000

Hello, I haven't work with PNG in Delphi, so I'm looking for advices about next problem: I have to show picture over picture, but I can't manage with the transparent spots, so the below one to be visible where the above should be transparent. I tried with Image component and pnglibrary, but still have no solution.

By: Michael Rockett

Michael Rockett — Fri, 15 Jan 2010 06:55:49 +0000

This looks very helpful - thanks for the post. I will try it as soon as I have my new computer.

Been looking for this for ages. Now I'm assuming any image will do the trick? Another semi-transparent image over the alpha layer?

By: Erik Knowles

Erik Knowles — Wed, 13 Jan 2010 17:45:34 +0000

Haven't found a way to do that. We use the following code to draw licensing information on top of the form (you can't directly use canvas.TextOut() because it draws with the alpha channel set to 0, so you need to use GDI+ functions with the {$define PNG_GDIPLUS} definition enabled). It's not completely self-explanatory, but hope it helps:

procedure TFormSplash.display_license_info(splashbmp : TGPImage) ;
var org, site : string ;
    left,top,height,width : integer ;
    fontsize : integer ;
    color : TColor ;
    x, y: integer ;
    word : string ;
    spacewidth : integer ;
    lineheight : integer ;
    outtext : string ;
    curpos : integer ;
    outtextlen : integer ;
    wordwidth : integer ;
 
    gp : TGPGraphics ;
    gpfont : TGPFont ;
    gpbrush : TGPBrush ;
    origin : TGPPointF ;
begin
    get_license_info(org, site) ;
    get_license_coords(left,top,width,height,fontsize,color) ;
 
    gp := TGPGraphics.Create(splashbmp) ;
 
    with self.canvas do begin
        font.Assign(self.font);
        font.color := color ;
        font.size := fontsize ;
 
        gpfont := TGPFont.Create(canvas.Handle) ;
        // V The addition is the Alpha channel. We want the text to be completely opaque
        gpbrush := TGPSolidBrush.Create($FF000000+DWord(color)) ;
 
        spacewidth := TextWidth(' ') ;
        lineheight := TextHeight(' ') ;
        x := left ; y := top ;
 
        outtext := org+#$0d+#$0a+site ;
        outtextlen := length(outtext) ;
        curpos := 1 ;
        while curpos<=outtextlen do begin
            word := '' ;
            while (curpos<=outtextlen) and not (outtext[curpos] in [' ',#$0a]) do begin
                if outtext[curpos]<>#$0d then
                        word := word+outtext[curpos] ;
                Inc(curpos)
            end ;
            wordwidth := TextWidth(word) ;
            if (x<>left) and (x+wordwidth-left>width) then begin
                x := left ;
                y := y+lineheight ;
            end ;
 
            origin.X := x ; origin.Y := y ;
            gp.DrawString(word, -1, gpfont, origin, gpbrush) ;
 
            if curpos<=outtextlen then
                if outtext[curpos]=' ' then
                        x := x+wordwidth+spacewidth
                else if outtext[curpos]=#$0a then begin
                        x := left ;
                        y := y+lineheight
                end ;
            Inc(curpos) ;
 
            if y+lineheight-top>height then break ;
        end ; // while curpos<=outtextlen
    end ; // with self.canvas
 
    gpbrush.Free ;
    gpfont.Free ;
    gp.Free ;
end ;

By: Erik Knowles

Erik Knowles — Wed, 13 Jan 2010 17:41:57 +0000

Thanks Tim, I found the same problem (only shows up when Aero is enabled, which unfortunately it wasn't when testing under VMWare).