Delphi 为我们提供了三个方便的函数:
GlobalAllocPtr {简化自 API 的 GlobalAlloc} GlobalReAllocPtr {简化自 API 的 GlobalReAlloc} GlobalFreePtr {简化自 API 的 GlobalFree}
读写本程序以外的数据时可以使用它们,
很方便, 譬如:
p := GlobalAllocPtr(0, Len); {分配} p := GlobalReAllocPtr(p, Len, 0); {重分配} GlobalFreePtr(p); {释放}
注意
GlobalAllocPtr 的第一个参数和 GlobalReAllocPtr 的最后一个参数, 上面给的都是 0;
这两个参数的意义是一样的,
规范一点应该写成 GMEM_FIXED (表示分配固定内存), 常用的参数还有:
GMEM_MOVEABLE {分配可移动内存} GMEM_ZEROINIT {同时清空内存} GHND {分配可移动内存同时清空} GPTR {分配固定内存同时清空}
参数还有很多,
和相应的 API 函数的参数是一致的.
下面的例子并没有使用进程以外的对象, 可以把 Memo1.Handle
换做外部的其他文本容器(譬如记事本)试一试:
代码文件:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls; type TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var p: Pointer;
Len: Integer; begin Len := 6+1; {假如想要读出 6 个字符, 要留出结束的空字符} p := GlobalAllocPtr(0, Len*2); {分配内存 Len*2 是针对双字节字符} SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGe} GlobalFreePtr(p); end; procedure TForm1.Button2Click(Sender: TObject); var p: Pointer;
Len: Integer; begin Len := 6+1; {假如想要读出 6 个字符, 要流出结束的空字符} p := GlobalAllocPtr(0, Len*2); {分配内存 Len*2 是针对双字节字符} SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGe} {在上一例的基础上继续, 先获取实际长度} Len := SendMessage(Memo1.Handle, WM_GETTEXTLENGTH, 0, 0);
Len := (Len + 1) * 2;
p := GlobalReAllocPtr(p, Len, GHND); {重新分配内存} SendMessage(Memo1.Handle, WM_GETTEXT, Len, Cardinal(p));
ShowMessage(PChar(p)); {CodeGear Delphi 2009} GlobalFreePtr(p); end; procedure TForm1.FormCreate(Sender: TObject); begin Memo1.Align := alLeft;
Memo1.ScrollBars := ssVertical;
Memo1.Text := \'CodeGear Delphi 2009\'; end; end.
窗体文件:
object Form1: TForm1
Left = 0 Top = 0 Caption = \'Form1\' ClientHeight = 151 ClientWidth = 295 Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11 Font.Name = \'Tahoma\' Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo
Left = 8 Top = 8 Width = 169 Height = 89 Lines.Strings = (
\'Memo1\')
TabOrder = 0 end object Button1: TButton
Left = 192 Top = 32 Width = 75 Height = 25 Caption = \'Button1\' TabOrder = 1 OnClick = Button1Click
end object Button2: TButton
Left = 192 Top = 72 Width = 75 Height = 25 Caption = \'Button2\' TabOrder = 2 OnClick = Button2Click
end end
|