1,183
社区成员
发帖
与我相关
我的任务
分享
GDIPUTIL, GDIPAPI, GDIPOBJ, {GDI+ 需要}
pngimage, {PNG 需要}
ActiveX;{内存流需要}
type
TFixedStreamAdapter = class(TStreamAdapter)
public
function Stat(out statstg: TStatStg; grfStatFlag: Longint): HResult;
override; stdcall;
end;
function TFixedStreamAdapter.Stat(out statstg: TStatStg;
grfStatFlag: Integer): HResult;
begin
Result := inherited Stat(statstg, grfStatFlag);
statstg.pwcsName := nil;
end;
procedure DrawBkgroud; { 合成图片的过程 }
具体实现如下:
procedure TForm1.DrawBkgroud;
var
Bg: TGPBitmap;
G: TGPGraphics;
Guid: TGUID;
WD: TGPBitmap;
Cav: TGPBitmap;
Png: TPngImage;
MS: TMemoryStream;
FontFamily: TGPFontFamily;
LFont, SFont: TGPFont; { 字体 }
LPointF, SPointF: TGPPointF;
LSolidBrush, SSolidBrush: TGPSolidBrush;
begin
Png := TPngImage.CreateBlank(COLOR_RGBALPHA, 16, 359, 272); { 创建指定大小 359 * 272 空白的png }
{有同学会问 那个 359,272 是怎么得到的呢?额,根据背景图片大小自己写的。。。 }
Png.SaveToFile('png_out.png'); { 测试保存,结果是一个带 Alpha 通道的空白 PNG }
MS := TMemoryStream.Create;
Png.SaveToStream(MS);{ 保存到内存流,待用 }
Png.Free;
Bg := TGPBitmap.Create('bg.png'); { 载入背景图片 }
WD := TGPBitmap.Create('0.png'); { 载入天气状况图片 }
Cav := TGPBitmap.Create(TFixedStreamAdapter.Create(MS)); { 从内存流创建窗体背景图 }
MS.Free;
G := TGPGraphics.Create(Cav);{ 开始合成 }
FontFamily := TGPFontFamily.Create('Tahoma');
LFont := TGPFont.Create('Tahoma', 20, FontStyleBold, UnitPixel); { 大字体 }
SFont := TGPFont.Create('微软雅黑', 15, FontStyleBold, UnitPixel); { 小字体 }
LSolidBrush := TGPSolidBrush.Create(MakeColor(26, 161, 245));{ 字体颜色 }
SSolidBrush := TGPSolidBrush.Create(MakeColor(240, 240, 240));
G.DrawImage(Bg, 30, 30);
G.DrawImage(WD, 0, 0);
LPointF := MakePoint(130.0, 60.0);{ 位置 }
G.DrawString('25~32℃', -1, LFont, LPointF, LSolidBrush);
SPointF := MakePoint(130.0, 98.0);
G.DrawString('晴转阴,间中有钱掉下', -1, SFont, SPointF, SSolidBrush);
SPointF := MakePoint(130.0, 120.0);
G.DrawString('微风,风力 18 级', -1, SFont, SPointF, SSolidBrush);
{ 测试存为 png ... }
GetEncoderClsid('image/png', Guid);
Cav.Save('out.png', Guid);{ 看看合成结果呗 }
RenderForm(220, Cav); { 将窗体设置为靓靓背景吧。。。}
Cav.Free;
WD.Free;
G.Free;
Bg.Free;
end;
{过程名程:RenderForm(透明度,窗体背景图)}
procedure RenderForm(TransparentValue: Byte; SourceImage: TGPBitmap);
procedure TForm1.RenderForm(TransparentValue: Byte; SourceImage: TGPBitmap);
var
zsize: TSize;
zpoint: TPoint;
zbf: TBlendFunction;
TopLeft: TPoint;
WR: TRect;
GPGraph: TGPGraphics;
m_hdcMemory: HDC;
hdcScreen: HDC;
hBMP: HBITMAP;
FDC: HDC;
begin
hdcScreen := GetDC(0);
m_hdcMemory := CreateCompatibleDC(hdcScreen);
hBMP := CreateCompatibleBitmap(hdcScreen, SourceImage.GetWidth(),
SourceImage.GetHeight());
SelectObject(m_hdcMemory, hBMP);
GPGraph := TGPGraphics.Create(m_hdcMemory);
try
{ GPGraph.SetInterpolationMode(InterpolationModeHighQualityBicubic); }
GPGraph.DrawImage(SourceImage, 0, 0, SourceImage.GetWidth(),
SourceImage.GetHeight());
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED); { 这个必须有 }
zsize.cx := SourceImage.GetWidth;
zsize.cy := SourceImage.GetHeight;
zpoint := Point(0, 0);
with zbf do
begin
BlendOp := AC_SRC_OVER;
BlendFlags := 0;
AlphaFormat := AC_SRC_ALPHA;
SourceConstantAlpha := TransparentValue;
end;
GetWindowRect(Handle, WR);
TopLeft := WR.TopLeft;
{ UpdateLayeredWindow(Handle, FDC, @TopLeft, @zsize, GPGraph.GetHDC, @zpoint,
0, @zbf, ULW_ALPHA); WIN7 里面可以,WINXPSP3 就不行。。。所以改为以下:}
UpdateLayeredWindow(Handle, 0, nil, @zsize, GPGraph.GetHDC, @zpoint, 0,
@zbf, ULW_ALPHA);
finally
GPGraph.ReleaseHDC(m_hdcMemory);
ReleaseDC(0, hdcScreen);
DeleteObject(hBMP);
DeleteDC(m_hdcMemory);
GPGraph.Free;
end;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.MnuAboutClick(Sender: TObject);
begin
Application.MessageBox
('模拟天气预报,GDI+ 实现。' + #13#10 +
'email: sail2000#126.com' + #13#10 + '2010/09/10, 小帆, 广州', '关于',
MB_OK + MB_ICONINFORMATION);
end;
procedure TForm1.MnuClose1Click(Sender: TObject);
begin
Close { 886 }
end;