Delphi使用GDI+绘制Png图像
最近在使用鱼鱼桌面秀和雪狐桌面精灵的时候发现一些很漂亮的png图片,但是在Delphi里面没有办法直接加载Png图片进行绘制,所以试用了GDI+进行绘制.效果如下,我使用了雪狐桌面精灵里面的一张图片
你需要去www.2ccc.com先下载GDI+的Pascal头文件,连接地址如下
http://mirror1.2ccc.com/downloads/vcl/graphics/gdiplus.zip
下载之后请将其解压,然后把里面的Pas目录加入到Delphi的LibraryPath里面,这样Delphi才能找到他们,或者你可以直接将pas目录文件Copy到你的工程目录下面放在一起也可以.我就这么干地:-)
全部源代码如下:
1.Project.dpr文件内容:
1 program Project1;
2
3
4 uses
5 Windows,
6 PublicUnit in 'PublicUnit.pas',
7 MainWindow in 'MainWindow.pas';
8
9 var
10 Msg:TMsg;
11 begin
12 while GetMessage(Msg, 0, 0, 0) do
13 begin
14 TranslateMessage(Msg);
15 DispatchMessage(Msg);
16 end;
17 end.
2
3
4 uses
5 Windows,
6 PublicUnit in 'PublicUnit.pas',
7 MainWindow in 'MainWindow.pas';
8
9 var
10 Msg:TMsg;
11 begin
12 while GetMessage(Msg, 0, 0, 0) do
13 begin
14 TranslateMessage(Msg);
15 DispatchMessage(Msg);
16 end;
17 end.
2.MainWindow.pas文件内容如下
1 unit MainWindow;
2
3 interface
4 uses
5 Windows, Messages,PublicUnit,GDIPAPI,GDIPOBJ;
6 var
7 m_Image: TGPImage;
8 dwExStyle: DWORD;
9 HDC_Memory: HDC;
10 m_Blend: BLENDFUNCTION;
11 function UpdateLayeredWindow(Handle: THandle; hdcDest: HDC; pptDst: PPoint; _psize: PSize;
12 hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): Boolean; stdcall;
13 implementation
14 function UpdateLayeredWindow; external 'user32.dll' name 'UpdateLayeredWindow';
15
16 procedure PaintForm(hWnd:Handle);
17 var
18 hdcTemp, hdcScreen: HDC;
19 hBit_Map: HBITMAP;
20 rec: TRect;
21 ptWinPos, ptSrc: TPoint;
22 graph: TGPGraphics;
23 size: TSize;
24 begin
25
26 hdcTemp := GetDC(0);
27 HDC_Memory := CreateCompatibleDC(hdcTemp);
28 hBit_Map := CreateCompatibleBitmap(hdcTemp,
29 m_Image.GetWidth(), m_Image.GetHeight());
30 SelectObject(HDC_Memory, hBit_Map);
31 hdcScreen := GetDC(0);
32 GetWindowRect(FormHandle, rec);
33 ptWinPos.X := rec.Left;
34 ptWinPos.Y := rec.Top;
35 if ((dwExStyle and $80000) <> $80000) then
36 begin
37 SetWindowLong(hWnd, GWL_EXSTYLE, dwExStyle or $80000);
38 end;
39 graph := TGPGraphics.Create(HDC_Memory);
40 graph.DrawImage(m_Image, 0, 0, m_Image.GetWidth, m_Image.GetHeight);
41 size.cx := m_Image.GetWidth;
42 size.cy := m_Image.GetHeight;
43 ptSrc.X := 0;
44 ptSrc.Y := 0;
45 UpdateLayeredWindow(hWnd, hdcScreen, @ptWinPos,
46 @size, HDC_Memory, @ptSrc, 0, @m_Blend, 2);
47 graph.ReleaseHDC(HDC_Memory);
48 ReleaseDC(0, hdcScreen);
49 ReleaseDC(0, hdcTemp);
50 DeleteObject(hBit_Map);
51 DeleteDC(HDC_Memory);
52 end;
53
54 // 窗体过程回调函数
55 function MainProc(hMain, MsgID, WParam, LParam: DWORD): DWORD; stdcall;
56 begin
57 case MsgID of
58 WM_LBUTTONDOWN:
59 begin
60 ReleaseCapture;
61 SendMessage(hMain,WM_SYSCOMMAND,SC_MOVE, 0);
62 end;
63 WM_RBUTTONUP:
64 begin
65 PostQuitMessage(0);
66 end;
67 WM_PAINT:
68 begin
69 PaintForm(hMain);
70 end;
71 WM_CREATE:
72 begin
73 m_Image := TGPImage.Create(ExtractFilePath(ParamStr(0))+'1.png');
74 m_Blend.BlendOp := 0;
75 m_Blend.BlendFlags := 0;
76 m_Blend.AlphaFormat := 1;
77 m_Blend.SourceConstantAlpha := 255;
78 dwExStyle := GetWindowLong(hMain, GWL_EXSTYLE);
79 end;
80
81 WM_DESTROY:
82 begin
83 PostQuitMessage(0); // 放WM_QUIT到消息队列
84 end;
85 end;
86 Result := DefWindowProc(hMain, MsgID, WParam, LParam); // 标准处理
87 end;
88
89 // 建立主窗体
90 procedure Create_MainWindow;
91 var
92 MainClass: TWndClass;
93 begin
94 MainClass.Style := CS_HREDRAW or CS_VREDRAW;
95 MainClass.lpfnWndProc := @MainProc;
96 MainClass.cbClsExtra := 0;
97 MainClass.cbWndExtra := 0;
98 MainClass.hInstance := SysInit.HInstance;
99 MainClass.hIcon := LoadIcon(0,nil);
100 MainClass.hCursor := LoadCursor(0, IDC_ARROW);
101 MainClass.hbrBackground := COLOR_BTNFACE + 1;
102 MainClass.lpszMenuName := nil;
103 MainClass.lpszClassName := 'MainWindowClass';
104 if RegisterClass(MainClass)=0 then
105 begin
106 Halt;
107 end;
108 FormHandle:=CreateWindowEx(WS_EX_TOPMOST, MainClass.lpszClassName, '空白窗体',
109 WinStyleFrom,
110 200, 200, 260, 280, 0, 0, HInstance, nil);
111 if FormHandle=0 then
112 begin
113 Halt;
114 end;
115 end;
116
117 initialization
118 Create_MainWindow;
119
120 end.
121
2
3 interface
4 uses
5 Windows, Messages,PublicUnit,GDIPAPI,GDIPOBJ;
6 var
7 m_Image: TGPImage;
8 dwExStyle: DWORD;
9 HDC_Memory: HDC;
10 m_Blend: BLENDFUNCTION;
11 function UpdateLayeredWindow(Handle: THandle; hdcDest: HDC; pptDst: PPoint; _psize: PSize;
12 hdcSrc: HDC; pptSrc: PPoint; crKey: COLORREF; pblend: PBLENDFUNCTION; dwFlags: DWORD): Boolean; stdcall;
13 implementation
14 function UpdateLayeredWindow; external 'user32.dll' name 'UpdateLayeredWindow';
15
16 procedure PaintForm(hWnd:Handle);
17 var
18 hdcTemp, hdcScreen: HDC;
19 hBit_Map: HBITMAP;
20 rec: TRect;
21 ptWinPos, ptSrc: TPoint;
22 graph: TGPGraphics;
23 size: TSize;
24 begin
25
26 hdcTemp := GetDC(0);
27 HDC_Memory := CreateCompatibleDC(hdcTemp);
28 hBit_Map := CreateCompatibleBitmap(hdcTemp,
29 m_Image.GetWidth(), m_Image.GetHeight());
30 SelectObject(HDC_Memory, hBit_Map);
31 hdcScreen := GetDC(0);
32 GetWindowRect(FormHandle, rec);
33 ptWinPos.X := rec.Left;
34 ptWinPos.Y := rec.Top;
35 if ((dwExStyle and $80000) <> $80000) then
36 begin
37 SetWindowLong(hWnd, GWL_EXSTYLE, dwExStyle or $80000);
38 end;
39 graph := TGPGraphics.Create(HDC_Memory);
40 graph.DrawImage(m_Image, 0, 0, m_Image.GetWidth, m_Image.GetHeight);
41 size.cx := m_Image.GetWidth;
42 size.cy := m_Image.GetHeight;
43 ptSrc.X := 0;
44 ptSrc.Y := 0;
45 UpdateLayeredWindow(hWnd, hdcScreen, @ptWinPos,
46 @size, HDC_Memory, @ptSrc, 0, @m_Blend, 2);
47 graph.ReleaseHDC(HDC_Memory);
48 ReleaseDC(0, hdcScreen);
49 ReleaseDC(0, hdcTemp);
50 DeleteObject(hBit_Map);
51 DeleteDC(HDC_Memory);
52 end;
53
54 // 窗体过程回调函数
55 function MainProc(hMain, MsgID, WParam, LParam: DWORD): DWORD; stdcall;
56 begin
57 case MsgID of
58 WM_LBUTTONDOWN:
59 begin
60 ReleaseCapture;
61 SendMessage(hMain,WM_SYSCOMMAND,SC_MOVE, 0);
62 end;
63 WM_RBUTTONUP:
64 begin
65 PostQuitMessage(0);
66 end;
67 WM_PAINT:
68 begin
69 PaintForm(hMain);
70 end;
71 WM_CREATE:
72 begin
73 m_Image := TGPImage.Create(ExtractFilePath(ParamStr(0))+'1.png');
74 m_Blend.BlendOp := 0;
75 m_Blend.BlendFlags := 0;
76 m_Blend.AlphaFormat := 1;
77 m_Blend.SourceConstantAlpha := 255;
78 dwExStyle := GetWindowLong(hMain, GWL_EXSTYLE);
79 end;
80
81 WM_DESTROY:
82 begin
83 PostQuitMessage(0); // 放WM_QUIT到消息队列
84 end;
85 end;
86 Result := DefWindowProc(hMain, MsgID, WParam, LParam); // 标准处理
87 end;
88
89 // 建立主窗体
90 procedure Create_MainWindow;
91 var
92 MainClass: TWndClass;
93 begin
94 MainClass.Style := CS_HREDRAW or CS_VREDRAW;
95 MainClass.lpfnWndProc := @MainProc;
96 MainClass.cbClsExtra := 0;
97 MainClass.cbWndExtra := 0;
98 MainClass.hInstance := SysInit.HInstance;
99 MainClass.hIcon := LoadIcon(0,nil);
100 MainClass.hCursor := LoadCursor(0, IDC_ARROW);
101 MainClass.hbrBackground := COLOR_BTNFACE + 1;
102 MainClass.lpszMenuName := nil;
103 MainClass.lpszClassName := 'MainWindowClass';
104 if RegisterClass(MainClass)=0 then
105 begin
106 Halt;
107 end;
108 FormHandle:=CreateWindowEx(WS_EX_TOPMOST, MainClass.lpszClassName, '空白窗体',
109 WinStyleFrom,
110 200, 200, 260, 280, 0, 0, HInstance, nil);
111 if FormHandle=0 then
112 begin
113 Halt;
114 end;
115 end;
116
117 initialization
118 Create_MainWindow;
119
120 end.
121
3.PublicUnit.pas公共函数单元
1 unit PublicUnit;
2
3 interface
4 uses
5 Windows;
6 type
7 Handle=LongWord;
8 const
9 WinStyleDlg=WS_TILED or WS_VISIBLE or WS_SYSMENU;
10 WinStyleFrom=WS_VISIBLE or WS_TILED or WS_SYSMENU or WS_MINIMIZEBOX or WS_SIZEBOX or WS_MAXIMIZEBOX;
11 var
12 FormHandle:Handle;
13 function ExtractFilePath(const FileName: string): string; // 解析出文件路径
14 implementation
15 // -- 解析出文件路径 -- //
16 function ExtractFilePath(const FileName: string): string;
17 var
18 P: Integer;
19 begin
20 P := Length(FileName);
21 while (P > 0)and(FileName[P] <> '\')and(FileName[P] <> ':') do Dec(P);
22 Result := Copy(FileName, 1, P);
23 end;
24 end.
2
3 interface
4 uses
5 Windows;
6 type
7 Handle=LongWord;
8 const
9 WinStyleDlg=WS_TILED or WS_VISIBLE or WS_SYSMENU;
10 WinStyleFrom=WS_VISIBLE or WS_TILED or WS_SYSMENU or WS_MINIMIZEBOX or WS_SIZEBOX or WS_MAXIMIZEBOX;
11 var
12 FormHandle:Handle;
13 function ExtractFilePath(const FileName: string): string; // 解析出文件路径
14 implementation
15 // -- 解析出文件路径 -- //
16 function ExtractFilePath(const FileName: string): string;
17 var
18 P: Integer;
19 begin
20 P := Length(FileName);
21 while (P > 0)and(FileName[P] <> '\')and(FileName[P] <> ':') do Dec(P);
22 Result := Copy(FileName, 1, P);
23 end;
24 end.
