Delphi下用API代码创建Form
2016-02-25 18:20
615 查看
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
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中MethodAddress汇编代码的解析
- 用Delphi进行word开发
- Delphi中多标签页面的实现
- 关于Delphi中TRttiContext.FindType失效的问题
- Delphi中拖动无边框窗口的5种方法
- Delphi TListView刷新闪烁问题
- Delphi中关于资源释放(Free/release/freeAndNil)的一点体会
- delphi控件安装(重安装系统也不用再安装)
- Delphi - 软件注册的一个例子
- 深入VCL源码研究DELPHI窗体的创建和关闭
- Delphi XE4 For IOS 之SQLite初试
- Delphi XE4 For IOS中程序的调试(虚拟机,真实机和win32)
- .net C# inputBox文字输入对话框,类似delphi的inputBox
- delphi7打开的时候一直让说注册失效,然后不让进入到开发界面
- delphi socket使用心得
- Delphi7编译时,发生Access violation at address 00A7B628 in module 'dcc70.dll'. Read of address 00000000.(Delphi6升级到Delphi7)
- Delphi 运行Word VBA 宏 删除软回车
- 转:Delphi XE4 语言变化 [Weak] [Unsafe]
- 在delphi如何把TADOQuery.ParamCheck
- Delphi XE7中新并行库