API图像函数(delphi).doc

WinAPI: ExtractIcon - 获取 EXE、DLL 或 ICO 文件中的图标
//声明:
ExtractIcon(
hInst: HINST; {调用函数的程序实例}
lpszExeFileName: PChar; {文件路径; 文件可以是 *.exe、*.dll、*.ico}
nIconIndex: UINT {图标索引}
): HICON; {返回图标句柄; 索引为 0 时返回第一个图标句柄; 索引为 #FFFFFFFF 时返回图标总数}

//举例:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI; {ExtractIcon 在其中声明}

procedure TForm1.Button1Click(Sender: TObject);
var
ico: TIcon;
i,count,x,y,w,h: Integer;
FilePath: string;
begin
{随便找了个路径, 如果缺失会退出}
FilePath := 'C:\Program Files\Macromedia\Fireworks 8\Fireworks.exe';
if not FileExists(FilePath) then begin ShowMessage('文件不存在'); Exit; end;

ico := TIcon.Create;
x := 10; y := 10; w := 0; h := 0;
Repaint;

{先算出文件内的图标总数}
count := ExtractIcon(HInstance, PChar(FilePath), HICON(-1));

for i := 0 to count - 1 do
begin
{循环提取图标}
ico.Handle := ExtractIcon(HInstance, PChar(FilePath), i);

{画出图标}
Canvas.Draw(x,y,ico);

{下面只是调整显示位置}
if w < ico.Width then w := ico.Width;
if h < ico.Height then h := ico.Height;
x := x + ico.Width + 10;
if x >= ClientWidth - w then
begin
x := 10;
y := y + h + 10;
end;
end;

ico.Free;
end;

end.

//效果图:

WinAPI: LoadBitmap - 从资源中载入位图
//声明:
LoadBitmap(
hInstance: HINST; {EXE 或 DLL 的句柄}
lpBitmapName: PChar {资源标识符}
): HBITMAP; {返回位图句柄}

这里有示例

WinAPI: LoadCursor - 从资源中载入光标
//声明:
LoadCursor(
hInstance: HINST; {EXE 或 DLL 的句柄, 0 表示载入系统资源}
lpCursorName: PChar {资源标识符}
): HCURSOR; {返回光标句柄}

这里有示例

//调用系统光标的例子:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
cur: TIcon;
begin
cur := TIcon.Create;

cur.Handle := LoadCursor(0, IDC_HAND);
Canvas.Draw(11,11,cur);
cur.Handle := LoadCursor(0, IDC_HELP);
Canvas.Draw(44,11,cur);

cur.Free;
end;

end.

//效果图:

//附系统光标列表:
IDC_ARROW = MakeIntResource(32512);
IDC_IBEAM = MakeIntResource(32513);
IDC_WAIT = MakeIntResource(32514);
IDC_CROSS = MakeIntResource(32515);
IDC_UPARROW = MakeIntResource(32516)
IDC_SIZE = MakeIntResource(32640);
IDC_ICON = MakeIntResource(32641);
IDC_SIZENWSE = MakeIntResource(32642);
IDC_SIZENESW = MakeIntResource(32643);
IDC_SIZEWE = MakeIntResource(32644);
IDC_SIZENS = MakeIntResource(32645);
IDC_SIZEALL = MakeIntResource(32646);
IDC_NO = MakeIntResource(32648);
IDC_HAND = MakeIntResource(32649);
IDC_APPSTARTING = MakeIntResource(32650);
IDC_HELP = MakeIntResource(32651);

WinAPI: LoadIcon - 从资源中载入图标
//声明:
LoadIcon(
hInstance: HINST; {EXE 或 DLL 的句柄, 0 表示载入系统资源}
lpIconName: PChar {资源标识符}
): HICON; {返回图标句柄}

这里有示例

//调用系统图标的例子:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
ico: TIcon;
i,x: Integer;
begin
ico := TIcon.Create;
x := 10;
for i := 32512 to 32517 do
begin
ico.Handle := LoadIcon(0, MakeIntResource(i));
Canvas.Drawx,10,ico);
Inc(x,ico.Width+10);
end;
ico.Free;
end;

end.

//效果图:

//附系统图标列表:
IDI_APPLICATION = MakeIntResource(32512);
IDI_HAND = MakeIntResource(32513);
IDI_QUESTION = MakeIntResource(32514);
IDI_EXCLAMATION = MakeIntResource(32515);
IDI_ASTERISK = MakeIntResource(32516);
IDI_WINLOGO = MakeIntResource(32517);
IDI_WARNING = IDI_EXCLAMATION;
IDI_ERROR = IDI_HAND;
IDI_INFORMATION = IDI_ASTERISK;

WinAPI: AlphaBlend - 图像透明度
AlphaBlend(
DC: HDC; {目标设备环境句柄}
p2, p3, p4, p5: Integer; {目标位置与宽高}
DC6: HDC; {源设备环境句柄}
p7, p8, p9, p10: Integer; {源位置与宽高}
p11: TBlendFunction {合成方式的数据结构, 见下表}
): BOOL;

//TBlendFunction 结构是 _BLENDFUNCTION 的重命名:
_BLENDFUNCTION = packed record
BlendOp: BYTE; {本例使用了: AC_SRC_OVER = 0}
BlendFlags: BYTE; {必须为 0}
SourceConstantAlpha: BYTE; {透明度: 0..255}
AlphaFormat: BYTE; {通常为 0，如果源位图为32位真彩色，可为 AC_SRC_ALPHA }
end;

本例效果图:

代码文件:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
TrackBar1: TTrackBar;
procedure FormCreate(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
Bit,BitBack: TBitmap;
Transparency: Byte = 255; {透明度}

procedure TForm1.FormCreate(Sender: TObject);
begin
{设定窗体背景}
BitBack := TBitmap.Create;
BitBack.LoadFromFile('c:\temp\Back.bmp');
Brush.Bitmap := BitBack;

{调入图片}
Bit := TBitmap.Create;
Bit.LoadFromFile('c:\temp\testbmp');

{给 TrackBar1 初始化}
TrackBar1.Max := 255;
TrackBar1.Min := 0;
TrackBar1.ShowSelRange := False;
TrackBar1.Position := TrackBar1.Max;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
Blend: TBlendFunction; {定义 AlphaBlend 要使用的 TBlendFunction 结构}
begin
{给 TBlendFunction 结构赋值}
Blend.BlendOp := AC_SRC_OVER;
Blend.BlendFlags := 0;
Blend.AlphaFormat := 0;
Blend.SourceConstantAlpha := Transparency;

Windows.AlphaBlend(Canvas.Handle, {因 VCL 有同名属性, 所以指定了是来自 Windows 单元}
10,
10,
Bit.Width + 10,
Bit.Height + 10,
Bit.Canvas.Handle,
0,
0,
Bit.Width,
Bit.Height,
Blend
);
end;

procedure TForm1.TrackBar1ChangeSender: TObject);
begin
Transparency := TrackBar1.Position;
Text := IntToStr(Transparency);
Self.Repaint; {命令重绘}
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Bit.Free;
BitBack.Free;
end;

end.

窗体设计:

object Form1: TForm1
Left = 352
Top = 238
Caption = 'Form1'
ClientHeight = 209
ClientWidth = 211
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesigned
OnCreate = FormCreate
OnDestroy = FormDestroy
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object TrackBar1: TTrackBar
Left = 0
Top = 186
Width = 201
Height = 24
TabOrder = 0
OnChange = TrackBar1Change
end
end

用 GDI 操作 EMF 文件[1]: CreateEnhMetaFile、CloseEnhMetaFile
EMF 文件是 Windows 下的增强图元文件, 本例用最简单的代码创建了一个 EMF 文件.

CreateEnhMetaFile(
DC: HDC; {所参照的 DC, 为 0 表示参照当前的显示设备}
FileName: PChar; {文件名, 为 nil 表示创建内存文件}
Rect: PRect; {外接矩形(单位是 0.1 毫米), 为 nil 表示使用最小矩形}
Desc: PChar {描述性的说明文本, 可为 nil}
): HDC;

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
Path = 'C:\Temp\MyMetaFile.emf'; {CreateEnhMetaFile 创建文件时, 存在则覆盖}
var
MetaFileDC: HDC; {EMF 文件 DC}
begin
MetaFileDC := CreateEnhMetaFile(0, PChar(Path), nil, nil); {建立}
Ellipse(MetaFileDC, 10, 10, 100, 60); {绘制}
CloseEnhMetaFile(MetaFileDC); {关闭并保存}
DeleteObject(MetaFileDC);
end;

end.

增强图元文件的相关函数:

CloseEnhMetaFile {}
CopyEnhMetaFile {}
CreateEnhMetaFile {}
DeleteEnhMetaFile {}
EnhMetaFileProc {}
EnumEnhMetaFile {}
GdiComment {}
GetEnhMetaFile {}
GetEnhMetaFileBits {}
GetEnhMetaFileDescription {}
GetEnhMetaFileHeader {}
GetEnhMetaFilePaletteEntries {}
GetWinMetaFileBits {}
PlayEnhMetaFile {}
PlayEnhMetaFileRecord {}
SetEnhMetaFileBits {}
SetWinMetaFileBits {}

用 GDI 操作 EMF 文件[2]: PlayEnhMetaFile、DeleteEnhMetaFile
创建 EMF 文件, 并同时绘制在窗体.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
Path = 'C:\Temp\MyMetaFile.emf';
var
MetaFileDC: HDC; {EMF 画布句柄}
HMetaFile: HENHMETAFILE {EMF 文件句柄}
begin
MetaFileDC := CreateEnhMetaFile(0, PChar(Path), nil, nil);
Ellipse(MetaFileDC, 10, 10, 100, 60);
HMetaFile := CloseEnhMetaFile(MetaFileDC);

{在窗体上按原始大小绘制 EMF}
PlayEnhMetaFile(Canvas.Handle, HMetaFile, Rect(10,10,100,60));

DeleteObject(MetaFileDC);
DeleteEnhMetaFile(HMetaFile);
end;

end.

用 GDI 操作 EMF 文件[3]: GetEnhMetaFile
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
Path = 'C:\Temp\MyMetaFile.emf'; {假定这个文件还在}
var
HMetaFile: HENHMETAFILE; {EMF 文件句柄}
begin
HMetaFile := GetEnhMetaFile(PChar(Path)); {打开}
PlayEnhMetaFile(Canvas.Handle, HMetaFile, Rect(10,10,100,60)); {重新绘制 EMF}
DeleteEnhMetaFile(HMetaFile);
end;

end.

用 GDI 操作 EMF 文件[4]: 重绘 EMF
本例效果图:

代码文件:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
HMetaFile: HENHMETAFILE;
f: Boolean;
x1,y1: Integer;
R: TRect;

procedure TForm1.FormCreate(Sender: TObject);
const
Path = 'C:\Temp\MyMetaFile.emf';
begin
HMetaFile := GetEnhMetaFile(PChar(Path));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteEnhMetaFile(HMetaFile);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
f := True;
x1 := X;
y1 := Y;
R := Rect(x1,y1,X,Y);
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not f then Exit;
DrawFocusRect(Canvas.Handle, R);
R := Rect(x1,y1,X,Y);
DrawFocusRect(Canvas.Handle, R);
R := Rect(x1,y1,X,Y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
f := False;
PlayEnhMetaFile(Canvas.Handle, HMetaFile, R);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Refresh;
end;

end.

窗体文件:

object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 206
ClientWidth = 339
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnMouseDown = FormMouseDown
OnMouseMove = FormMouseMove
OnMouseUp = FormMouseUp
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 256
Top = 173
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
end

用 GDI 操作 EMF 文件[5]: GetEnhMetaFileDescription - 获取 EMF 文件的说明文本
再用 CreateEnhMetaFile 函数建立 EMF 文件时可以同时写入描述性说明;

用 GetEnhMetaFileDescription 函数可以读出 EMF 文件的说明文本.

本例给的说明文本非常简单, 不过标准的说明文本的格式应该是: 程序名#0文件标题#0#0

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
HMetaFile: HENHMETAFILE {EMF 文件句柄}

{建立带说明的 EMF 文件}
procedure TForm1.FormCreate(Sender: TObject);
const
Path = 'C:\Temp\MyMeateFile.emf';
Description = 'ABCDE'; {当作 EMF 文件的说明}
var
MetaFileDC: HDC;
begin
{建立并写入说明}
MetaFileDC := CreateEnhMetaFile(0, PChar(Path), nil, PChar(Description));
{绘图}
Rectangle(MetaFileDC, 11, 11, 111, 111);
{结束编辑、保存文件, 并返回文件句柄}
HMetaFile := CloseEnhMetaFile(MetaFileDC);
{删除 DC}
DeleteObject(MetaFileDC);
end;

{读取 EMF 文件的说明}
procedure TForm1.Button1Click(Sender: TObject);
var
DescriptionSize: Integer; {说明段的大小}
DescriptionBuf: PChar; {接受说明的内存指针}
begin
{获取大小}
DescriptionSize := GetEnhMetaFileDescription(HMetaFile, 0, nil);
{分配内存}
GetMem(DescriptionBuf, DescriptionSize);
{获取说明}
GetEnhMetaFileDescription(HMetaFile, DescriptionSize, DescriptionBuf);
{显示说明}
ShowMessage(DescriptionBuf); {ABCDE}
{释放内存}
FreeMem(DescriptionBuf);
end;

{绘制在窗体}
procedure TForm1.Button2Click(Sender: TObject);
begin
PlayEnhMetaFile(Canvas.Handle, HMetaFile, Rect(11,11,111,111));
end;

{删除 EMF 文件句柄}
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteEnhMetaFile(HMetaFile);
end;

end.

用 GDI 操作 EMF 文件[