dlgtmplt.pas

这一系列是我平时收集的pascal深入核心变成

unit DlgTmplt;

interface

uses Windows;

type
 // 对话框模板结构
  PDlgTemplateEx = ^TDlgTemplateEx;
  TDlgTemplateEx = packed record
    wDlgVer: WORD; // TDlgTemplateEx结构版本号, 目前总是1
    wSignature: WORD; // 此处总是$FFFF, 标识TDlgTemplateEx结构
    dwHelpID: DWORD;
    dwExStyle: DWORD; // 窗体扩展风格, 比如 WS_EX_TOPMOST
    dwStyle: DWORD;   // 窗体风格, 比如 WS_CAPTION
    cDlgItems: WORD;
    x, y: SHORT; // 窗体屏幕位置, 象素单位
    cx, cy: SHORT; // 窗体尺寸, 对话框单位
   // 之后有三个Zero-terminated Unicode字符串: 菜单资源名, 窗体类名, 窗体标题
   // 如果存在DS_SETFONT风格的话, 随后就是TFontInfoEx结构,
   // 如果有子控件的话, 后面还有n个TDlgItemTemplateEx结构
  end;

 // 对话框字体结构
  PFontInfoEx = ^TFontInfoEx;
  TFontInfoEx = packed record
    nPointSize: SHORT; // 点数
    nWeight: SHORT; // 宽度
    fItalic: SHORT; // 斜体
   // 之后有一个Zero-terminated Unicode字符串, 代表字体名称
  end;

 // 对话框控件结构
  PDlgItemTemplateEx = ^TDlgItemTemplateEx;
  TDlgItemTemplateEx = packed record
    dwHelpID: DWORD;
    dwExStyle: DWORD; // 控件扩展风格, 比如 WS_EX_CONTROLPARENT
    dwStyle: DWORD; // 控件风格, 比如 WS_TABSTOP
    x, y: SHORT;    // 控件位置, 对话框单位
    cx, cy: SHORT;  // 控件尺寸, 对话框单位
    id: DWORD;      // 控件ID
   // 之后有两个Zero-terminated Unicode字符串: 控件类名, 控件标题
   // 然后是一个双字节变量wExtraCount: WORD, 表示额外内存空间尺寸,
   // 如果 wExtraCount 不是0, 随后就是额外空间数据字节序列 ..
  end;

 // 申请对话框模板结构所需的内存并填充, UniCode版
function DlgTemplate_CreateW(dwStyle, dwExStyle, dwHelpId: DWORD; x, y, cx, cy: SHORT;
  szMenuName, szClassName, szCaptionText: PWideChar; nPointSize, nWeight, fItalic: SHORT;
  szTypeFace: PWideChar): PDlgTemplateEx;

 // 申请对话框模板结构所需的内存并填充, Ansi版
function DlgTemplate_CreateA(dwStyle, dwExStyle, dwHelpId: DWORD; x, y, cx, cy: SHORT;
  szMenuName, szClassName, szCaptionText: PChar; nPointSize, nWeight, fItalic: SHORT;
  szTypeFace: PChar): PDlgTemplateEx;

 // 向对话框模板结构尾部追加子控件结构, UniCode版
function DlgTemplate_AddControlW(var ppDlgTemplate: PDlgTemplateEx;
  x, y, cx, cy: SHORT; id, dwHelpId, dwStyle, dwExStyle: DWORD;
  szClass, szText: PWideChar; wExtraDataCount: WORD; pbExtraData: PByte): BOOL;

 // 向对话框模板结构尾部追加子控件结构, Ansi版
function DlgTemplate_AddControlA(var ppDlgTemplate: PDlgTemplateEx;
  x, y, cx, cy: SHORT; id, dwHelpId, dwStyle, dwExStyle: DWORD;
  szClass, szText: PChar; wExtraDataCount: WORD; pbExtraData: PByte): BOOL;

 // 释放整个对话框模板结构内存
function DlgTemplate_Free(pDlgTemplate: PDlgTemplateEx): BOOL;

implementation

 // 根据指针求内存块对齐长度, 这个方法来自《Delphi源代码分析》(周爱民著, 电子工业出版社)
 // 注意: 下面的函数仅在我的 Delphi7 作了简单测试, 不保证总是正确的.
function GetAlignSize(const p: Pointer): Integer;
begin
  Result := PInteger(Integer(p) - 4)^ and $7FFFFFFC - SizeOf(Integer);
end;

 // 下一个DWORD边界位置
function NextDWORDBoundAry(p: PByte): PByte;
begin
  Result := PByte((3 + Integer(p)) and not 3);
end;

 // 按DWORD对齐后的长度
function LenInDWORDs(ByteLen: Integer): Integer;
begin
  Result := (ByteLen + SizeOf(DWORD) - 1) and not 3;
end;

 // Unicode字符串字节数(含终止符)
function BytesForString(sz: PWideChar): Integer;
begin
  Result := SizeOf(WideChar) * (1 + lstrlenW(sz));
end;

 // 字符串编码转换 Ansi -> Unicode
function AnsiToUnicode(szStrA: PChar; var pszStrW: PWideChar): BOOL;
var
  nLenOfWideCharStr: Integer;
begin
 // 无需转换, Return(TRUE);
  if (szStrA = nil) then
  begin
    pszStrW := nil;
    Result := TRUE;
    Exit;
  end;

 // 求Unicode版本字符串长度
  nLenOfWideCharStr := MultiByteToWideChar(CP_ACP, 0, szStrA, -1, nil, 0);

 // 为Unicode字符串分配内存
  GetMem(pszStrW, nLenOfWideCharStr * SizeOf(WideChar));

 // 分配成功则转换为Unicode
  if (pszStrW <> nil) then
  begin
    MultiByteToWideChar(CP_ACP, 0, szStrA, -1, pszStrW, nLenOfWideCharStr);
    Result := TRUE;
  end else
    Result := FALSE;
end;

 // 申请对话框模板结构所需的内存并填充, UniCode版
function DlgTemplate_CreateW(dwStyle, dwExStyle, dwHelpId: DWORD; x, y, cx, cy: SHORT;
  szMenuName, szClassName, szCaptionText: PWideChar; nPointSize, nWeight, fItalic: SHORT;
  szTypeFace: PWideChar): PDlgTemplateEx;
var
  nBytesForNewTemplate, nMenuNameLen, nClassNameLen, nCaptionTextLen, nTypeFaceLen: Integer;
  pbDlgTemplate, pbDlgTypeFace: PByte;
  pFontInfo: PFontInfoEx;
begin
 // 各字符串字节长度(菜单, 类名, 标题)
  nMenuNameLen := BytesForString(szMenuName);
  nClassNameLen := BytesForString(szClassName);
  nCaptionTextLen := BytesForString(szCaptionText);

 // 对话框模板结构的长度
  nBytesForNewTemplate :=
    SizeOf(TDlgTemplateEx) + nMenuNameLen + nClassNameLen + nCaptionTextLen;

 // 指定了非默认字体
  if (dwStyle and DS_SETFONT) <> 0 then
  begin
   // 字体名字符串长度
    nTypeFaceLen := BytesForString(szTypeFace);

   // 增加模板结构长度
    Inc(nBytesForNewTemplate, SizeOf(TFontInfoEx) + nTypeFaceLen);
  end else
  begin
   // 使用默认字体
    nTypeFaceLen := 0;

   // 总长度不增加
  end;

 // 按DWORD对齐后的长度
  nBytesForNewTemplate := LenInDWORDs(nBytesForNewTemplate);

 // 分配对话框模板内存块
  GetMem(Result, nBytesForNewTemplate);
  if (Result = nil) then Exit;

 // 填写TDlgTemplateEx结构
  Result.wDlgVer := 1; // TDlgTemplateEx结构版本号, 目前总是1
  Result.wSignature := $FFFF; // 此处总是$FFFF, 标识新的TDlgTemplateEx结构
  Result.dwHelpID := dwHelpId;
  Result.dwStyle := dwStyle;
  Result.dwExStyle := dwExStyle;
  Result.cDlgItems := 0; // 子控件数量
  Result.x := x;
  Result.y := y;
  Result.cx := cx;
  Result.cy := cy;

 // 定位TDlgTemplateEx尾部
  pbDlgTemplate := PByte(Integer(Result) + SizeOf(TDlgTemplateEx));

 // 填写: 菜单、类名、标题
  CopyMemory(pbDlgTemplate, szMenuName, nMenuNameLen);
  Inc(pbDlgTemplate, nMenuNameLen);
  CopyMemory(pbDlgTemplate, szClassName, nClassNameLen);
  Inc(pbDlgTemplate, nClassNameLen);
  CopyMemory(pbDlgTemplate, szCaptionText, nCaptionTextLen);
  Inc(pbDlgTemplate, nCaptionTextLen);

 // 指定了非默认字体
  if (dwStyle and DS_SETFONT) <> 0 then
  begin
   // 定位TFontInfoEx结构
    pFontInfo := PFontInfoEx(pbDlgTemplate);

   // 填写TFontInfoEx结构
    pFontInfo.nPointSize := nPointSize;
    pFontInfo.nWeight := nWeight;
    pFontInfo.fItalic := fItalic;

   // 定位TFontInfoEx尾部
    pbDlgTypeFace := PByte(Integer(pFontInfo) + SizeOf(TFontInfoEx));

   // 填写字体名称字符串
    CopyMemory(pbDlgTypeFace, szTypeFace, nTypeFaceLen);
  end;
end;

 // 申请对话框模板结构所需的内存并填充, Ansi版
function DlgTemplate_CreateA(dwStyle, dwExStyle, dwHelpId: DWORD; x, y, cx, cy: SHORT;
  szMenuName, szClassName, szCaptionText: PChar; nPointSize, nWeight, fItalic: SHORT;
  szTypeFace: PChar): PDlgTemplateEx;
var
  szMenuNameW, szClassNameW, szCaptionTextW, szTypeFaceW: PWideChar;
begin
 // 分配内存并且作转换, 转换成功返回TRUE
  if AnsiToUnicode(szMenuName, szMenuNameW) and
  AnsiToUnicode(szClassName, szClassNameW) and
  AnsiToUnicode(szCaptionText, szCaptionTextW) and
  AnsiToUnicode(szTypeFace, szTypeFaceW) then
  begin
    Result := DlgTemplate_CreateW(dwStyle, dwExStyle, // 调用Unicode版对应函数
      dwHelpId, x, y, cx, cy, szMenuNameW, szClassNameW,
      szCaptionTextW, nPointSize, nWeight, fItalic, szTypeFaceW);
  end else
  begin
    Result := nil;
  end;

 // 释放先前分配的内存
  FreeMem(szTypeFaceW);
  FreeMem(szCaptionTextW);
  FreeMem(szClassNameW);
  FreeMem(szMenuNameW);
end;

 // 向对话框模板结构尾部追加子控件结构, UniCode版
function DlgTemplate_AddControlW(var ppDlgTemplate: PDlgTemplateEx;
  x, y, cx, cy: SHORT; id, dwHelpId, dwStyle, dwExStyle: DWORD;
  szClass, szText: PWideChar; wExtraDataCount: WORD; pbExtraData: PByte): BOOL;
var
  nBytesForNewControl, nBytesBeforeAddingControl: Integer;
  pDlgItemTemplate: PDlgItemTemplateEx;
  pbDlgItemTemplate: PByte;
  nClassLen, nTextLen: Integer;
begin
  Result := FALSE;

 // 类名和标题的字节长度
  nClassLen := BytesForString(szClass);
  nTextLen := BytesForString(szText);

 // 新增控件模板结构长度
  nBytesForNewControl := SizeOf(TDlgItemTemplateEx) + nClassLen + nTextLen + SizeOf(WORD);

 // 按照 DWORD作边界对齐
  nBytesForNewControl := LenInDWORDs(nBytesForNewControl);

 // 添加控件额外内存长度
  Inc(nBytesForNewControl, wExtraDataCount); 

 // 按照 DWORD作边界对齐
  nBytesForNewControl := LenInDWORDs(nBytesForNewControl);

 // 对话框模板结构的长度
  nBytesBeforeAddingControl := GetAlignSize(ppDlgTemplate);

 // 重新分配(扩大空间)
  ReallocMem(ppDlgTemplate, nBytesBeforeAddingControl + nBytesForNewControl);
  if (ppDlgTemplate = nil) then Exit;

 // 增加子控件窗体个数
  Inc(ppDlgTemplate.cDlgItems, 1);

 // 定位TDlgItemTemplateEx结构
  pDlgItemTemplate := PDlgItemTemplateEx(Integer(ppDlgTemplate) + nBytesBeforeAddingControl);

 // 填写TDlgItemTemplateEx结构
  pDlgItemTemplate.x := x;
  pDlgItemTemplate.y := y;
  pDlgItemTemplate.cx := cx;
  pDlgItemTemplate.cy := cy;
  pDlgItemTemplate.id := id;
  pDlgItemTemplate.dwStyle := dwStyle or WS_CHILD;
  pDlgItemTemplate.dwExStyle := dwExStyle;
  pDlgItemTemplate.dwHelpID := dwHelpId;

 // 定位TDlgItemTemplateEx尾部
  pbDlgItemTemplate := PByte(Integer(pDlgItemTemplate) + SizeOf(TDlgItemTemplateEx));

 // 填写子控件窗体的类名和标题
  CopyMemory(pbDlgItemTemplate, szClass, nClassLen);
  Inc(pbDlgItemTemplate, nClassLen);
  CopyMemory(pbDlgItemTemplate, szText, nTextLen);
  Inc(pbDlgItemTemplate, nTextLen);

 // 填写控件窗体额外内存字节数
  PWORD(pbDlgItemTemplate)^ := wExtraDataCount;
  Inc(pbDlgItemTemplate, SizeOf(WORD));

 // 填写控件窗体的额外内存数据
  CopyMemory(pbDlgItemTemplate, pbExtraData, wExtraDataCount);

  Result := TRUE;
end;

 // 向对话框模板结构尾部追加子控件结构, Ansi版
function DlgTemplate_AddControlA(var ppDlgTemplate: PDlgTemplateEx;
  x, y, cx, cy: SHORT; id, dwHelpId, dwStyle, dwExStyle: DWORD;
  szClass, szText: PChar; wExtraDataCount: WORD; pbExtraData: PByte): BOOL;
var
  szClassW, szTextW: PWideChar;
begin
 // 分配内存并且作转换, 转换成功返回TRUE
  if AnsiToUnicode(szClass, szClassW) and AnsiToUnicode(szText, szTextW) then
  begin
    Result := DlgTemplate_AddControlW(ppDlgTemplate, // 调用Unicode版对应函数
      x, y, cx, cy, id, dwHelpId, dwStyle, dwExStyle,
      szClassW, szTextW, wExtraDataCount, pbExtraData);
  end else
  begin
    Result := FALSE;
  end;
  
 // 释放先前分配的内存
  FreeMem(szTextW);
  FreeMem(szClassW);
end;

 // 释放内存
function DlgTemplate_Free(pDlgTemplate: PDlgTemplateEx): BOOL;
begin
  FreeMem(pDlgTemplate);
  Result := TRUE;
end;

end.