The previous PNG control is slightly improved.

In the past, when images come in through a path in a small amount, they still cannot be seen. When 20 images are put on the bed, it feels a little flash, the information of the tpicture image is faster in the DFM file than it is loaded one by one, and it can still be done in a single EXE file when the program is released.

 

Unit gdipanel;

 

Interface

 

Uses

Sysutils, classes, controls, extctrls, gdipobj, gdiputil, gdipapi, graphics, designintf;

 

Type

Tgdipanel = Class (tpaintbox)

Private

Flabel: string;

Fpicture: tpicture;

Fcoloroflable: tcolor;

Fcolorofshadow: tcolor;

Fww: integer;

Ffontoflabel: tfont;

 

 

Procedure GDI (Sender: tobject );

Procedure draw (Sender: tobject );

Procedure setlabelcolor (value: tcolor );

Procedure setshadowcolor (value: tcolor );

Procedure setlabel (value: string );

Procedure setlabelfont (value: tfont );

Procedure setfww (value: integer );

Procedure setpicture (const value: tpicture );

{Private Declarations}

Protected

Procedure paint; override;

{Protected Declarations}

Public

{Public dec -- larations}

Constructor create (aowner: tcomponent); override;

Destructor destroy; override;

Published

Property lable: String read flabel write setlabel;

Property fontoflabel: tfont read ffontoflabel write setlabelfont;

Property picture: tpicture read fpicture write setpicture;

Property coloroflable: tcolor read fcoloroflable write setlabelcolor default clred;

Property colorofshadow: tcolor read fcolorofshadow write setshadowcolor default clblack;

Property WW: integer read fww write setfww default 2;

{Published Declarations}

End;

 

Procedure register;

 

Implementation

 

Procedure register;

Begin

Registercomponents ('samples', [tgdipanel]);

Registerpropertyincategory ('layout ', 'lable ');

Registerpropertyincategory ('layout ', 'fontoflabel ');

Registerpropertyincategory ('layout ', 'protocolable ');

Registerpropertyincategory ('layout ', 'rorofshadow ');

End;

 

{Tgdipanel}

 

Constructor tgdipanel. Create (aowner: tcomponent );

Begin

Inherited;

Ffontoflabel: = tfont. Create;

Fpicture: = tpicture. Create;

Fpicture. onchange: = GDI;

Fww: = 2;

Fcoloroflable: = clred;

Fcolorofshadow: = clblack;

End;

 

Destructor tgdipanel. Destroy;

Begin

Ffontoflabel. Free;

Fpicture. Free;

Inherited;

End;

 

Procedure tgdipanel. Draw (Sender: tobject );

VaR

G: tgpgraphics;

B: tgpbrush;

Font: tgpfont;

SF: tgpstringformat;

Rect: tgprectf;

Begin

If flabel <> ''then

Begin

G: = tgpgraphics. Create (sender as tpaintbox). Canvas. Handle );

G. settextrenderinghint (textrenderinghintantialias );

Font: = tgpfont. Create (ffontoflabel. Name, ffontoflabel. size );

SF: = tgpstringformat. Create;

SF. setformatflags (stringformatflagsnoclip );

SF. setalignment (tstringalignment (stringalignmentcenter ));

SF. setlinealignment (tstringalignment (stringalignmentcenter ));

 

B: = tgpsolidbrush. Create (colorreftoargb (colorofshadow ));

Rect. X: = 0;

Rect. Y: = 0;

Rect. Width: = (sender as tpaintbox). clientwidth + fww;

Rect. Height: = (sender as tpaintbox). clientheight + fww;

G. drawstring (flabel,-1, Font, rect, SF, B );

 

B: = tgpsolidbrush. Create (colorreftoargb (fcoloroflable ));

Rect. X: = 0;

Rect. Y: = 0;

Rect. Width: = (sender as tpaintbox). clientwidth;

Rect. Height: = (sender as tpaintbox). clientheight;

G. drawstring (flabel,-1, Font, rect, SF, B );

 

SF. Free;

Font. Free;

B. Free;

 

G. Free;

End;

End;

 

Procedure tgdipanel. GDI (Sender: tobject );

VaR

G: tgpgraphics;

IMG: tgpimage;

RT: tgprectf;

X, Y: Cardinal;

Temp: tmemorystream;

Adapter: tstreamadapter;

Begin

If fpicture. Graphic <> nil then

Begin

G: = tgpgraphics. Create (self. Canvas. Handle );

Temp: = tmemorystream. Create;

Fpicture. Graphic. savetostream (temp );

Adapter: = tstreamadapter. Create (temp, soowned );

IMG: = tgpimage. Create (adapter );

// G. drawimage (IMG, 0, 0, IMG. getwidth, IMG. getheight );

 

X: = self. width;

Y: = self. height;

 

RT: = makerect (0, 0, x, y );

 

G. setinterpolationmode (interpolationmodehighqualitybicubic );

G. drawimage (IMG, RT, 0, 0, IMG. getwidth, IMG. getheight, unitpixel );

 

IMG. Free;

G. Free;

End;

End;

 

Procedure tgdipanel. paint;

Begin

Inherited;

GDI (Self );

Draw (Self );

End;

 

Procedure tgdipanel. setfww (value: integer );

Begin

If fww <> value then

Begin

Fww: = value;

Paint;

End;

End;

 

Procedure tgdipanel. setlabel (value: string );

Begin

If flabel <> value then

Begin

Flabel: = value;

Paint;

End;

End;

 

Procedure tgdipanel. setlabelcolor (value: tcolor );

Begin

If fcoloroflable <> value then

Begin

Fcoloroflable: = value;

Paint;

End;

End;

 

Procedure tgdipanel. setlabelfont (value: tfont );

Begin

If ffontoflabel <> value then

Begin

Ffontoflabel: = value;

Paint;

End;

End;

 

Procedure tgdipanel. setpicture (const value: tpicture );

Begin

Fpicture. Assign (value );

End;

 

Procedure tgdipanel. setshadowcolor (value: tcolor );

Begin

If fcolorofshadow <> value then

Begin

Fcolorofshadow: = value;

Paint;

End;

End;

 

End.