Use PNG to implement a translucent form

Source: Internet
Author: User
Standard controls in Delphi do not support PNG images. It is said that the gdiplus. dll library is added after window2000 to process more GDI images, including PNG. Key APIs: gdipcreatebitmapfromfile (), load an image from a file (not just Bitmap) gdipcreatebitmapfromstreamicm (), import the image gdipcreatehbitmapfrombitmap () from the stream, and obtain the bitmap gdipdisposeimage (), failed to call gdipcreatebitmapfromfile directly after the image resource is released. The error 18 is returned. Check the information. The error is "gdiplusnotinitialized"
It seems necessary to initialize gdiplus. Find a set of "tgpbitmap"-related components on the Internet and encapsulate the call of gdiplus. You can refer to the code. After PNG is loaded, retrieve its bitmap. Note that the bitmap is 32-bit. Contains four color values: R, G, B, and Alpha. Alpha indicates transparency. The updatelayeredwindow () API function supports the Alpha style. How to load data from a stream? How to process the VCL stream into istream? Let's look at the code. :
Prepare a PNG Image, write the RC file, and add it to the project. Code: Cj7.rcPng_cj7 PNG "cj7.png" Cj7unit. Pas

Unit cj7unit;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs;

Type
Tformcj7 = Class (tform)
Procedure formcreate (Sender: tobject );
Procedure formmousedown (Sender: tobject; button: tmousebutton;
Shift: tshiftstate; X, Y: integer );
Private
{Private Declarations}
Public
{Public declarations}
End;

VaR
Formcj7: tformcj7;

Implementation

{$ R *. DFM}

Uses ActiveX;

Type
Debugeventlevel = (
Debugeventlevelfatal,
Debugeventlevelwarning
);
Tdebugeventlevel = debugeventlevel;

Debugeventproc = procedure (Level: debugeventlevel; message: pchar); stdcall;

Gdiplusstartupinput = packed record
Gdiplusversion: Cardinal;
Debugeventcallback: debugeventproc;
Suppressbackgroundthread: bool;
Suppressexternalcodecs: bool;
End;
Tgdiplusstartupinput = gdiplusstartupinput;
Pgdiplusstartupinput = ^ tgdiplusstartupinput;

Notificationhookproc = function (out token: ulong): integer; stdcall;
Notificationunhookproc = procedure (token: ulong); stdcall;

Gdiplusstartupoutput = packed record
Icationicationhook: notificationhookproc;
Notificationunhook: icationicationunhookproc;
End;
Tgdiplusstartupoutput = gdiplusstartupoutput;
Pgdiplusstartupoutput = ^ tgdiplusstartupoutput;

Function gdipcreatehbitmapfrombitmap (Bitmap: thandle; out hbmreturn: hbitmap;
Background: longword): integer; stdcall; External 'gdiplus. dll ';

Function gdipcreatebitmapfromfile (filename: pwchar; out bitmap: thandle): integer;
Stdcall; External 'gdiplus. dll ';

Function gdipcreatebitmapfromstreamicm (Stream: istream;
Out bitmap: thandle): integer; stdcall; External 'gdiplus. dll ';

Function gdipdisposeimage (image: thandle): integer; stdcall;
Stdcall; External 'gdiplus. dll ';

Function gdiplusstartup (out token: ulong; input: pgdiplusstartupinput;
Output: pgdiplusstartupoutput): integer; stdcall; External 'gdiplus. dll ';

Procedure gdiplusshutdown (token: ulong); stdcall; External 'gdiplus. dll ';

Procedure tformcj7.formcreate (Sender: tobject );
VaR
Vgdip: thandle;
Vbitmap: hbitmap;
Voldbitmap: hbitmap;
Vpoint1, vpoint2: tpoint;
Vsize: tsize;
Vblendfunction: tblendfunction;
VDC: HDC;
Vbitmapinfo: tbitmapinfoheader;
Vdibsection: tdibsection;
Vbuffer: pchar;
Vstream: istream;
Vglobal: thandle;
Begin
Setwindowlong (handle, gwl_exstyle,
Getwindowlong (handle, gwl_exstyle) or ws_ex_layered );

////// Begin load from the Resource
With tresourcestream. Create (hinstance, 'png _ cj7', 'png ') Do try
Vglobal: = globalalloc (ghnd, size );
If vglobal = 0 Then exit;
Vbuffer: = globallock (vglobal );
If not assigned (vbuffer) Then exit;
Try
Read (vbuffer ^, size );
Finally
Globalunlock (vgdip );
End;
If createstreamonhglobal (vglobal, false, vstream) <> s_ OK then exit;
If gdipcreatebitmapfromstreamicm (vstream, vgdip) <> s_ OK then exit;
Globalfree (vglobal );
Finally
Free;
End;
//// // End load from the Resource

If gdipcreatehbitmapfrombitmap (vgdip, vbitmap, 0) <> s_ OK then exit;
 
Vbitmapinfo. bisize: = sizeof (vbitmapinfo );
GetObject (vbitmap, sizeof (vdibsection), @ vdibsection );
Vpoint1: = point (left, top );
Vpoint2: = point (0, 0 );
Vsize. CX: = vdibsection. dsbm. bmwidth;
Vsize. Cy: = vdibsection. dsbm. bmheight;
Vblendfunction. blendop: = ac_src_over;
Vblendfunction. blendflags: = 0;
Vblendfunction. sourceconstantalpha: = $ ff; // transparency
Vblendfunction. alphaformat: = ac_src_alpha; // same as above
VDC: = createcompatibledc (canvas. Handle );
Voldbitmap: = SelectObject (VDC, vbitmap );
Updatelayeredwindow (handle, canvas. handle,
@ Vpoint1, @ vsize, VDC, @ vpoint2, 0, @ vblendfunction, ulw_alpha );
SelectObject (VDC, voldbitmap );
Deletedc (VDC );
Deleteobject (vbitmap );
Gdipdisposeimage (vgdip );
End;

Procedure tformcj7.formmousedown (Sender: tobject; button: tmousebutton;
Shift: tshiftstate; X, Y: integer );
Begin
Releasecapture;
Perform (wm_syscommand, SC _move or htclient, 0); // drag
End;

VaR
Vstartupinput: tgdiplusstartupinput;
Vtoken: ulong;

Initialization
Vstartupinput. debugeventcallback: = nil;
Vstartupinput. suppressbackgroundthread: = false;
Vstartupinput. suppressexternalcodecs: = false;
Vstartupinput. gdiplusversion: = 1;
Gdiplusstartup (vtoken, @ vstartupinput, nil );

Finalization
Gdiplusshutdown (vtoken );

End.

For more information about GDI +, see:

Http://msdn2.microsoft.com/en-us/library/ms533798.aspx

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.