• 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

  • 相关阅读:
    项目部署
    nginx
    IDEA中Lombok插件的安装与使用
    Git常用命令总结
    CentOS 7 NAT模式上网配置
    一名3年工作经验的java程序员应该具备的技能
    maven 项目加载本地JAR
    linux压缩(解压缩)命令详解
    jdk7与jdk8环境共存与切换
    linux服务器卸载本机默认安装的jdk
  • 原文地址:https://www.cnblogs.com/findumars/p/5217978.html
Copyright © 2020-2023  润新知