arcade.dpr

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

program Arcade;

{$R Arcade.res}

uses Windows, Messages, CommCtrl, AniBtn in 'AniBtn.pas', SuperCls in 'SuperCls.pas';

const
 // 对话框模板ID
  IDD_ARCADE = 105;

 // 对话框图标ID
  IDI_ARCADE = 106;

 // 动画图标ID..
  IDI_PONG1 = 110;
  IDI_PONG2 = 111;
  IDI_PONG3 = 112;
  IDI_PONG4 = 113;
  IDI_PONG5 = 114;
  IDI_PONG6 = 115;
  IDI_TETRIS1 = 130;
  IDI_TETRIS2 = 131;
  IDI_TETRIS3 = 132;
  IDI_TETRIS4 = 133;
  IDI_TETRIS5 = 134;
  IDI_TETRIS6 = 135;
  IDI_TETRIS7 = 136;

 // 按钮控件ID..
  IDC_PONG = 1010;
  IDC_TETRIS = 1011;

 // 建立图像列表
function Arcade_MakeImageList(HInstRes: THandle; IconList: array of Integer): HIMAGELIST;
var
  J: Integer;
begin
  Result := ImageList_Create(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON), ILC_MASK, 5, 5);
  if (Result = 0) then Exit;

  for J := Low(IconList) to High(IconList) do
    ImageList_AddIcon(Result, LoadIcon(HInstRes, MakeIntResource(IconList[J])));
end;

 // 对话框WM_INITDIALOG处理
function Arcade_OnInitDialog(hWnd, hWndFocus: HWND; lParam: LPARAM): BOOL;
var
  himl: HIMAGELIST;
begin
 // 为两个动画按钮建立图像列表, 注: 当按钮被清除, 图像列表也会被清除

 // 初始化"弹球"动画按钮
  himl := Arcade_MakeImageList(HInstance,
    [IDI_PONG1, IDI_PONG2, IDI_PONG3, IDI_PONG4, IDI_PONG5, IDI_PONG6]);
  AniBtn_SetImageList(GetDlgItem(hWnd, IDC_PONG), himl);
  AniBtn_SetTimer(GetDlgItem(hWnd, IDC_PONG), 250);

 // 初始化"俄罗斯"动画按钮
  himl := Arcade_MakeImageList(HInstance,
    [IDI_TETRIS1, IDI_TETRIS2, IDI_TETRIS3, IDI_TETRIS4, IDI_TETRIS5, IDI_TETRIS6, IDI_TETRIS7]);
  AniBtn_SetImageList(GetDlgItem(hWnd, IDC_TETRIS), himl);
  AniBtn_SetTimer(GetDlgItem(hWnd, IDC_TETRIS), 500);

 // 设置窗体图标
  SendMessage(hWnd, WM_SETICON, ICON_BIG, LoadIcon(HInstance, MakeIntResource(IDI_ARCADE)));

 // 接受默认焦点
  Result := TRUE;
end;

 // 对话框WM_COMMAND处理
procedure Arcade_OnCommand(hWnd: HWND; id: Integer; hWndCtl: HWND; codeNotify: UINT);
begin
  case (id) of
    IDCANCEL: // 要求关闭对话框
      begin
        EndDialog(hWnd, id);
      end;

    IDC_PONG: // 按下'弹球'按钮
      begin
        MessageBox(GetActiveWindow(), 'Imagine Pong running here.', 'Arcade', MB_OK);
      end;

    IDC_TETRIS: // 按下'俄罗斯'按钮
      begin
        MessageBox(GetActiveWindow(), 'Imagine Tetris running here.', 'Arcade', MB_OK);
      end;
  end;
end;

 // 对话框消息处理回调
function Arcade_DlgProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL; stdcall;
begin
  case (uMsg) of
    WM_INITDIALOG:
      begin
        Result := BOOL(SetWindowLong(hWnd, DWL_MSGRESULT,
          Longint(Arcade_OnInitDialog(hWnd, wParam, lParam))));
      end;

    WM_COMMAND:
      begin
        Arcade_OnCommand(hWnd, LOWORD(wParam), lParam, HIWORD(wParam));
        Result := TRUE;
      end;

    else Result := FALSE;
  end;  
end;

 // 程序'主线程'入口
var
  VerInfo: TOSVersionInfo;
begin
 // 在NT上拒绝运行
  ZeroMemory(@VerInfo, SizeOf(TOSVersionInfo));
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(VerInfo);
  if (VerInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and
     (VerInfo.dwMajorVersion <= 3) and (VerInfo.dwMinorVersion <= 51) then
  begin
    MessageBox(GetActiveWindow(),
      'This program may not run properly on Windows NT ' +
      'because it requires that the BS_BITMAP style be supported by the Windows'#$27 +
      ' Button class.',
      'Arcade', MB_OK);
  end;

 // 注册动画按钮类
  if (AniBtn_RegisterClass(HInstance, FALSE) <> INVALID_ATOM) then
  begin
   // 建立模态对话框
    DialogBox(HInstance, MakeIntResource(IDD_ARCADE), 0, @Arcade_DlgProc);

   // 注销动画按钮类
    AniBtn_UnregisterClass(HInstance);
  end;
end.