Implementation of a shaped form

zhaozj2021-02-17  37

There must be many people to see some strange strange forms, such as some screen wizards. In fact, it is very easy to achieve, it is good to do three points. Below I use Delphi to do a VCL control (TBMPSHAPE), you only need to specify a picture to turn the form into your image.

1. Prepare a bitmap picture, be sure to format

2. Place the VCL control on your form (FORM), pay attention to other containers, set the Picture property, specify the created picture.

3. Set the background color of the picture, must be your background color accuracy value

4. Write a line of code in the formcreate event of this form

Bmpshape1.apply;

It is possible to do it above, compile to run your form, is it different.

Below is the specific code, not too long.

Unit bmpshape; {2002/08/22 by Ultrared Create a window according to BMP file Note: 1. BMP file The top of the top of the upper left color is background color 2. BMPSHAPE control can only be used on the TFORM container 3. The BMP file can be 256 colors. Or 24-bit color 4. The large block background must be absolutely equal to the background color to get the normal effect} Interface

Uses Forms, Windows, Messages, Sysutils, Classes, Controls, Extctrls, Graphics

type TBmpShape = class (TImage) private {Private declarations} BackColor: TColor; // background color FColorDither: boolean; // whether to allow a certain background color dithering function GetRegion: HRGN; // foreground image region procedure setColorDither (cd: Boolean); protected {protected declarations} public {public declarations} constructor Create (AOwner: TComponent); override; procedure Apply; // use effect published {Published declarations} property Dither: Boolean read FColorDither write setColorDither; end;

PROCEDURE register;

IMPLEMENTATION

Procedure Register; Begin RegisterComponents ('Samples', [TBMPSHAPE]); END;

Procedure TBMPSHAPE.SETCOLORDITHER (CD: Boolean); Begin IF CD <> fcolordither the fcolordither: = cd;

CONSTRUCTOR TBMPSHAPE.CREATE (AOWNER: TComponent); Begin Inherited Create (Aowner); Backcolor: = RGB (0,0,0); fcolordither: = false;

// The core subroutine is obtained for the foreground area of ​​BMP images Function TBMPSHAPE.GETREGON: HRGN; VAR I, J: Integer; RGN1, RGN2: HRGN; Starty: Integer; R, G, B, R1, G1, B1: BYTE Cc: tcolor; begin if pictures.bitmap <> nil damap.canvas.pixels [0,0]; rgn1: = creterecTrGN (0, 0, 0); for i: = 0 to Picture.bitmap.width-1 Do Begin Starty: = - 1; for J: = 0 TO PICTURE.bitmap.Height-1 Do Begin Cc: = Picture.bitmap.canvas.pixels [i, j]; if fcolordither the begin // Allows and backgrounds have a certain color difference R: = (CC AND $ FF0000) SHR 16; g: = (cc and $ ff00) SHR 8; B: = CC and $ ff; r1: = (backcolor and $ ff0000) SHR 16; G1: = (BackColor and $ FF00) SHR 8; B1: = BackColor and $ FF; IF (ABS (R-R1) <10) AND (ABS (G-G1) <10) and (ABS (B) -b1) <10) THEN Begin if (Starty> = 0) and (j> = startY) THEN BEGIN RGN2: = CreateRectrGN (i, starty, i 1, j); Combinergn (RGN1, RGN1, RGN2, RGN_OR) Starty: = - 1; End; Else Begin if Starty <0 THEN Starty: = j else if j = (Picture.bitmap.Height-1) THEN // The bottom one point Begin RGN2: = CreateRectrgn (I, Starty, i 1, J); Combinergn (RGN1, RGN1, RGN2, RGN_OR); end; end; end else // does not allow color difference Begin if cc = backcolor dam If (Starty> = 0) And (j> = starty) THEN BEGIN RGN2: = CreateRectrGN (i, starty, i 1, j); Combinergn (RGN1, RGN1, RGN2, RGN_OR); startY: = - 1; end; end else Begin If Starty <0 Then Starty: = j else IF j = (Picture.bitmap.Height-1) THEN / / Latest 1 Begin RGN2: = CreateRectRGN (I, Starty, i 1, J); Combinergn (RGN1, RGN1, RGN2, RGN_OR); END; end;

End; End; Result: = RGN1; ELSE RESULT: = 0; end; procedure tbmpshape.Apply; begin if parent is tform dam = 0; Top: = 0; width: = Picture.bitmap.width; Height : = Picture.bitmap.Height; with (PARENT AS TFORM) Do Begin Border; Width: = Self.Width; Height: = Self.Height; End; SetwindowRgn (Parent.Handle, GetRegion, False); END; END;

End.

转载请注明原文地址:https://www.9cbs.com/read-30940.html

New Post(0)