layout.pas

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

unit Layout;

interface

uses Windows, Messages;

const
 // 特殊ID
  lPARENT = $10000; // 此特殊ID代表父窗体, (注: 正常控件ID不会超过$FFFF)
  IDC_LASTCHILD = $10001; // 此特殊ID标识TChild列表结束

type
 // 动作类型
  lACTION = (
    lSTRETCH, // 改变Metric
    lMOVE,    // 移动控件
    lVCENTER, // 垂直居中
    lHCENTER, // 水平居中
    lEND // 动作列表结尾标志
            );

 // 部分属性
  lPART = (
    lpLEFT = 0,   // 左边
    lpTOP = 1,    // 顶端
    lpRIGHT = 2,  // 右边
    lpBOTTOM = 3, // 底部
    lpWIDTH = 4,  // 宽度
    lpHEIGHT = 5, // 高度
    lpGROUP = 6   // 分组
          );

 // 动作对象
  lACTIONINFO = record
  case Integer of
    1: (nPart: Integer; idc: Integer; nPercent: Integer);
    2: (nMetric: Integer; idcFirst: Integer; idcLast: Integer);
    3: (nSide: Integer);
  end;
 (* typedef struct {
    union {
      int nPart; // Name used only for group oriented actions
      int nMetric; // Name used only for metric oriented actions
      int nSide; // Name used only for side oriented actions
      };
    union {
      int idc; // Used for all actions except group actions
      int idcFirst; // Used for group actions
      };
    union {
      int nPercent; // Used only for width/height actions
      int idcLast; // Used for group actions
      };
    } lACTIONINFO; *)
    
 // 规则状态
  RStates = (UNAPPLIED, APPLIED); // Rule has not been applied, Rule has been applied
  
 // 单个规则
  PRule = ^TRule;
  TRule = record
    Action: lACTION;    // 动作类型
    ActOn: lACTIONINFO; // 动作对象
    RelTo: lACTIONINFO; // 参考对象
    nOffset: Integer;   // 动作对象相对于参考对象的偏移量(使用对话框单位)
    fState: RStates;    // 内部使用: Rule application state flag
    nPixelOffset: Integer; // 内部使用: 象素单位的nOffset
  end;

const
 // 数组范围
  NUMPARTS = 7; // There are 7 parts: left, top, right, bottom, width, height and group
  NUMMETRICS = 6; // There are 6 metrics: left, top, right, bottom, width and height
  NUMSIDES = 4; // There are 4 sides: left, top, right and bottom.  
  
type
 /////////////////////////// Metric Flags //////////////////////////
  MFlag = (UNKNOWN, KNOWN); // Metric is unknown or known

 // 控件信息
  PChild = ^TChild;
  TChild = record
    idc: Integer; // 控件ID, (注: lPARENT代表父窗体)
    fFixed: BOOL; // TRUE则不需要移动 **
    afMetric: array[0..NUMMETRICS-1] of MFlag; // 属性状态表 (KNOWN or UNKNOWN)
    case Integer of
      0: (anMetric: array[0..NUMMETRICS-1] of Integer);  // 属性数值表
      1: (Rc: TRect; nWidth: Integer; nHeight: Integer); // 属性结构体
    // 注: 两种定义本质上没有区别, 目的只是为了增加程序可读性      
  end;

  // 根据规则调整所有控件
function Layout_ComputeLayout(hWndParent: HWND; pRules: PRule): BOOL; stdcall;

function Layout_ApplyRule(hWndParent: HWND; pRules: PRule; pChildList: PChild; PtRule: PRule): BOOL;

implementation

  // 几个范围判断小函数
function adgInRange(lo, val, hi: Integer): Boolean;
begin
  Result := (lo <= val) and (val <= hi);
end;
function IsPart(n: lPART): Boolean;
begin
  Result := (lpLEFT <= n) and (n <= lpGROUP);
end;
function IsMetric(n: lPART): Boolean;
begin
  Result := (lpLEFT <= n) and (n <= lpHEIGHT);
end;
function IsSide(n: lPART): Boolean;
begin
  Result := (lpLEFT <= n) and (n <= lpBOTTOM);
end;

 // MapDialogRect()仅适用于对话框, 本函数是他的扩展版本, 还可以用于普通窗口
function adgMapDialogRect(hWndParent: HWND; var Rc: TRect): BOOL;
const
 // 此字符串用来计算字符平均宽度
  szChars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  hWndDc: HDC;
  Size: TSize;
  cxChar, cyChar: Integer;
  hWndFont, hFontOriginal: HFONT;
begin
 // 如果是对话框, 直接用MapDialogRect()
  if (GetClassWord(hWndParent, GCW_ATOM) = 32770) then
  begin
    Result := MapDialogRect(hWndParent, Rc);
    Exit;
  end else
    Result := FALSE;

 // 取窗体设备内容句柄并且选入窗体字体
  hWndDc := GetDC(hWndParent);
  hWndFont := SendMessage(hWndParent, WM_GETFONT, 0, 0);
  if (hWndFont <> 0) then
    hFontOriginal := SelectObject(hWndDc, hWndFont)
  else
    hFontOriginal := 0;
    
 // Unfortunately, we cannot use GetTextMetrics to get the average character
 // width because the TEXTMETRIC structure's tmAveCharWidth member is
 // incorrect for proportional fonts. So, instead we compute the average
 // character width ourselves using the same technique employed by Windows
 // itself: We pass "a-zA-Z" to GetTextExtentPoint and average, rounding up.
 // (NOTE: We do not call GetTextExtentPoint32 because this function corrects
 // an error that Windows relies on)
  GetTextExtentPoint(hWndDc, szChars, SizeOf(szChars), Size);
  cyChar := Size.cy;
  cxChar := ((Size.cx div (SizeOf(szChars) div 2)) + 1) div 2;

 // 选出字体并删除设备内容句柄
  if (hWndFont <> 0) then SelectObject(hWndDc, hfontOriginal);
  ReleaseDC(hWndParent, hWndDc);

 // 转换坐标
  SetRect(Rc, Rc.Left * cxChar div 4,
    Rc.Top * cyChar div 8, Rc.Right * cxChar div 4, Rc.Bottom * cyChar div 8);

  Result := TRUE;
end;

  // 提示错误
procedure adgMB(s: PChar);
var
  szTMP: array[0..128] of Char;
begin
  GetModuleFileName(0, szTMP, SizeOf(szTMP));
  MessageBox(GetActiveWindow(), s, szTMP, MB_OK);
end;

  // 中止运行
procedure adgFAIL(szMSG: PChar);
begin
  MessageBox(GetActiveWindow(), szMSG, 'Assertion Failed', MB_OK or MB_ICONERROR);
  DebugBreak(); // 该函数在当前进程中产生断点,以便调用的线程能够向调试器发信号. **
end;

  // 相反的边
function Layout_GetOppositeSide(nSide: lPART): lPART;
begin
  case (nSide) of
    lpLEFT: Result := lpRIGHT;

    lpRIGHT: Result := lpLEFT;

    lpTOP: Result := lpBOTTOM;

    lpBOTTOM: Result := lpTOP;

    else adgFAIL('Invalid side');
  end;
end;

  // 其他未知的属性 **
function Layout_GetOtherUnknownMetric(nUnknownMetric: lPART): lPART;
begin
  case (nUnknownMetric) of
    lpLEFT, lpRIGHT: Result := lpWIDTH;

    lpTOP, lpBOTTOM: Result := lpHEIGHT;

    lpWIDTH: Result := lpRIGHT;

    lpHEIGHT: Result := lpBOTTOM;

    else adgFAIL('Invalid metric');
  end;
end;

  // 垂直属性
function Layout_MetricIsVertical(nMetric: lPART): BOOL;
begin
  case (nMetric) of
    lpLEFT, lpRIGHT, lpWIDTH: Result := FALSE;

    lpTOP, lpBOTTOM, lpHEIGHT: Result := TRUE;

    else adgFAIL('Invalid metric');
  end;
end;

  // 对控件作一次循环, 试图用已知量求未知量
procedure Layout_SolveChild(PtChild: PChild);
var
  J: Integer;
begin
 // 注: afMetric数组成员依次为: Left, Top, Right, Bottom, Width and Height
  for J := 0 to NUMMETRICS - 1 do
  begin
    if (PtChild.afMetric[J] = UNKNOWN) then // 如果属性J未知, 尝试用其他已知量来求
    begin
      case J of
        0, 1: // Left/Top = Right/Bottom - Width/Height
          begin
            if (PtChild.afMetric[J + 2] = KNOWN) and (PtChild.afMetric[J + 4] = KNOWN) then
            begin
              PtChild.anMetric[J] := PtChild.anMetric[J + 2] - PtChild.anMetric[J + 4];
              PtChild.afMetric[J] := KNOWN;
            end
          end;

        2, 3: // Right/Bottom = Left/Top + Width/Height
          begin
            if (PtChild.afMetric[J - 2] = KNOWN) and (PtChild.afMetric[J + 2] = KNOWN) then
            begin
              PtChild.anMetric[J] := PtChild.anMetric[J - 2] + PtChild.anMetric[J + 2];
              PtChild.afMetric[J] := KNOWN;
            end;
          end;

        4, 5: // Width/Height = Right/Bottom - Left/Top
          begin
            if (PtChild.afMetric[J - 2] = KNOWN) and (PtChild.afMetric[J - 4] = KNOWN) then
            begin
              PtChild.anMetric[J] := PtChild.anMetric[J - 2] - PtChild.anMetric[J - 4];
              PtChild.afMetric[J] := KNOWN;
            end;
          end;
      end; // END: case J of
    end;
  end; // END: for J := 0 to NUMMETRICS - 1 do
end;

  // 遍历控件列表查找指定ID的控件
function Layout_FindChild(pChildList: PChild; idcChild: Integer): PChild;
begin
  Result := pChildList;
  while (Result.idc <> IDC_LASTCHILD) do
  begin
    if (Result.idc = idcChild) then // 找到, 求一次未知量, 并返回
    begin
      Layout_SolveChild(Result);
      Exit;
    end;
    Inc(Result);
  end;
  adgFAIL('Child not found in child list');
  Result := nil;
end;

  // 建立指定窗体的控件列表
function Layout_CreateChildList(hWndParent: HWND; pnChildren: PInteger): PChild;
var
  J: Integer;
  hWnd: LongWord; // HWND
  PtChild: PChild;
begin
 // 控件个数存入pnChildren
  pnChildren^ := 0;
  hWnd := GetTopWindow(hWndParent);
  while IsWindow(hWnd) do
  begin
    hWnd := GetWindow(hWnd, GW_HWNDNEXT);
    Inc(pnChildren^);
  end;

 // 没有控件,则直接返回nil
  if (pnChildren^ = 0) then
  begin
    Result := nil;
    Exit;
  end;

 // 为控件列表分配内存, 列表中其中除了控件, 还有一个父窗体, 以及一个结尾标识
  GetMem(Result, (pnChildren^ + 2) * SizeOf(TChild));
  if (Result = nil) then Exit;

 // 第一个TChild是父窗体'子控件'
  PtChild := Result;
  PtChild.idc := lPARENT;
  GetClientRect(hWndParent, PtChild.Rc); // 主窗体位置
  for J := 0 to NUMSIDES - 1 do PtChild.afMetric[J] := KNOWN; // 全部已知
  PtChild.afMetric[Integer(lpWIDTH)] := UNKNOWN; // 计算宽度和高度 ..