Delphi下用API代码创建Form

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

posted @ 2016-02-25 18:20  findumars  Views(392)  Comments(0Edit  收藏  举报