program PMyWindowClass;

uses
  Windows,
  Messages,
  SysUtils;

type
  TMyWindow = class(TObject)
  private
    { Private declarations }
    WindowClass: WndClass;
    hWindow: HWnd;
    AMessage: TMsg;
    FAppName : String;
    FWndProc : TFNWndProc;

function WinRegister : Boolean; virtual;
    procedure CreateMyWindow;
  public
    { Public declarations }
    constructor Create;
    destructor Destroy; override;
    procedure WinCreate; virtual;
    procedure MyRun;

property ApplicationName : String read FAppName write FAppName;
    property WindowProcedure : TFNWndProc read FWndProc write FWndProc;
  end;

const
  AppName = 'MyClassDemo';

var
  myWindow : TMyWindow;

{ TMyWindow }

constructor TMyWindow.Create;
begin
end;

destructor TMyWindow.Destroy;
begin
  inherited;
end;

procedure TMyWindow.CreateMyWindow;
begin
  hWindow := CreateWindow(AppName, '面向对象方式设计窗口应用程序的范例',
              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);

if hWindow <> 0 then begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;
end;

procedure TMyWindow.WinCreate;
begin
  if WinRegister then
  begin
    CreateMyWindow;
  end;
end;

function TMyWindow.WinRegister : Boolean;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := FWndProc;
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := system.MainInstance;
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := PChar(FAppName);

Result := RegisterClass(WindowClass) <> 0;
end;

//
//Window Message Handling Procedure
//
function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
                    LParam: LPARAM): LRESULT; stdcall; export;

var
     dc : hdc;
     ps : TPaintStruct;
     r : TRect;

begin
  WindowProc := 0;

case AMessage of
    WM_PAINT :
      begin
         dc := BeginPaint(Window,ps);
         GetClientRect(Window,r);
         DrawText(dc,'使用TMyWindow类封装的Windows程序。这导致了使用面向对象方式设计窗口应用程序',-1,r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         EndPaint(Window,ps);
         Exit;
      end;
    wm_Destroy:
      begin
         PostQuitMessage(0);
         Exit;
      end;
  end;

WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;

procedure TMyWindow.MyRun;
begin
  while GetMessage(AMessage, 0, 0, 0) do begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end;

begin
  myWindow := TMyWindow.Create;
  myWindow.ApplicationName := AppName;
  myWindow.WindowProcedure := TFNWndProc(@WindowProc);
  myWindow.WinCreate;
  try
    myWindow.MyRun;
  finally
    FreeAndNil(myWindow);
  end;
end.

http://blog.csdn.net/diligentcatrich/article/details/8072649

Delphi下用API代码创建Form的更多相关文章

  1. AX 用代码创建FORM动态加控件,重载动态添加的控件的方法。

    eg. 范例:class\RFIDReadWriteForm/Build方法. formRun.controlMethodOverload(true); formRun.controlMethodOv ...

  2. DELPHI下API简述(1800个API)

    DELPHI下API简述 http://zero.cnbct.org/show.asp?id=144 auxGetDevCaps API 获取附属设备容量 auxGetNumDevs API 返回附属 ...

  3. HBase 学习之一 <<HBase使用客户端API动态创建Hbase数据表并在Hbase下导出执行>>

    HBase使用客户端API动态创建Hbase数据表并在Hbase下导出执行                       ----首先感谢网络能够给我提供一个开放的学习平台,如果没有网上的技术爱好者提供 ...

  4. Delphi代码创建形式规范 1.0

                Delphi代码创建形式规范 1.0 本规范的目的:给自己的代码一个统一而标准的外观,增强 可读性,可理解性,可维护性 本规范的原则:名称反映含义,形式反映结构 1.单元风格 ...

  5. Linux下开发python django程序(Form表单对象创建和使用)

    1.在setting.py文件中修改节点,注释掉其中一行 MIDDLEWARE_CLASSES = ( 'django.middleware.common.CommonMiddleware', 'dj ...

  6. 深入Delphi下的DLL编程

    深入Delphi下的DLL编程 作者:岑心 引 言 相信有些计算机知识的朋友都应该听说过“DLL”.尤其是那些使用过windows操作系统的人,都应该有过多次重装系统的“悲惨”经历——无论再怎样小心, ...

  7. DELPHI下的SOCK编程(转)

    DELPHI下的SOCK编程      本文是写给公司新来的程序员的,算是一点培训的教材.本文不会涉及太多的编程细节,只是简单讲解在DELPHI下进行Winsock编程最好了解的知识. 题外话:我认为 ...

  8. Delphi下的RTTI函数大全

    http://ljz9425.blog.163.com/blog/static/369148572008111635253858/ Delphi下的RTTI(下) 2008-12-16 15:52:5 ...

  9. DELPHI下的SOCK编程

     DELPHI下的SOCK编程(转自http://www.cnblogs.com/devcjq/articles/2325600.html) 本文是写给公司新来的程序员的,算是一点培训的教材.本文不会 ...

随机推荐

  1. Spring (一) IOC ( Inversion Of Control )

    前序 现在小米手机很火就还拿小米手机来举例子,上一篇写的关于SSH框架搭建是从小米手机公司内个整个流程方面来考虑,如何提高效率生产效率,这篇博客主要从公司外部环境说明如何提高生产效率,那么怎么才能提高 ...

  2. windows 下一个mysql password忘记改变

    到场mysql简介 my.ini 于[mysqld]以下被加入 skip-grant-tables win+R 热键 进cmd 然后输入命令net stop mysql  最后一点,使文件夹mysql ...

  3. 写了交互给后台后来不能用?bug多多多又找不到文件效率低?工作流程帮你优化起来~~~~

    前端工作流程(多方交互篇) 新的网页: 1.跟美工沟通,跟产品沟通,跟后台沟通.前两者主要是页面样式.后者主要是表单交互.用哪个框架之类的. 2.实现.(写清楚哪块是用什么验证方式的)→ 给后台. 3 ...

  4. windows下取linux系统里面的文件

    方法一:使用原生态的psftp 1.下载psftp.exe http://pan.baidu.com/s/1boVLHKF 2.双击psftp.exe 2.1 输入指令:open IP地址 (例如:o ...

  5. 素数环(C - 暴力求解)

    素数环(暴力)(紫书194页) Description   A ring is composed of n (even number) circles as shown in diagram. Put ...

  6. 2014 HDU多校弟九场I题 不会DP也能水出来的简单DP题

    听了ZWK大大的思路,就立马1A了 思路是这样的: 算最小GPA的时候,首先每个科目分配到69分(不足的话直接输出GPA 2),然后FOR循环下来使REMAIN POINT减少,每个科目的上限加到10 ...

  7. Nginx+tomcat集群环境搭建

    实验环境:windows xp sp3 Nginx版本:1.5.12: 下载地址:http://nginx.org/en/download.html Tomcat版本:6.0.39 下载地址:http ...

  8. php 解析url 和parse_url使用

    通过url进行传值,是php中一个传值的重要手段.所以我们要经常对url里面所带的参数进行解析,如果我们知道了url传递参数名称,例如 /index.php?name=tank&sex=1#t ...

  9. HapiJS开发手冊

    HapiJS开发手冊 作者:chszs.转载需注明.博客主页:http://blog.csdn.net/chszs 一.HapiJS介绍 HapiJS是一个开源的.基于Node.js的应用框架,它适用 ...

  10. visual studio 2010配置驱动开发环境

    visual studio 2010 配置驱动开发环境 ** 工具/材料 VS2010.WDK开发包 **  配置过程 以下将讲述VS2010驱动开发环境的配置过程,至于必要软件的安装过程这里不再赘述 ...