DELPHI 开发原生WINDOW窗口程序(过程/面向对象)

最新推荐文章于 2024-08-26 13:29:13 发布

原创最新推荐文章于 2024-08-26 13:29:13 发布 · 1k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#delphi #pascal #constructor #destructor #windows #application

DELPHI 专栏收录该内容

21 篇文章

订阅专栏

本文介绍了如何使用DELPHI进行原生Windows窗口程序的开发，包括过程和面向对象两种方法。首先定义消息结构体TMessage，接着定义消息回调函数WndProc，并将窗口信息注册到Windows系统中。然后通过CreateWindow创建窗口，并实现消息循环处理WM_PAINT、WM_Destroy、WM_LBUTTONDOWN等消息。在面向对象改造部分，创建了TMyWindow类，包含窗口注册、创建和消息处理的方法。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

一.DELPHI 开发原生WINDOW窗口程序(过程)
1.定义消息结构体TMessage(系统)
2.定义消息回调函数 WndProc
3.注册窗口信息到WINDOWS中(用到回调函数地址)
4.CreateWindow创建窗口
5.消息循环处理
program Project2;

uses
Windows, Messages, SysUtils;

const
AppName ='PascalHello';

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, '使用PASCAL撰写的NATIVE WINDOW程序', -1, r,
          DT_SINGLELINE or DT_CENTER or DT_VCENTER);
        EndPaint(Window, ps);
        Exit;
      end;
    WM_Destroy:
      begin
        PostQuitMessage(0);
      end;
    WM_LBUTTONDOWN:
      begin
        MessageBox(0, 'LBUTTONDOWN Click.', nil, mb_Ok);
      end;
    end;

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

function WinRegister: Boolean;
var
WindowClass: WndClass;
begin
WindowClass.style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := TFNWndProc(@WindowProc);
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 := AppName;

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

function WinCreate: HWnd;
var
hWindow: HWnd;
begin
hWindow := CreateWindow(AppName, 'Hell0 world Object Pascal Program',
              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;

Result := hWindow;
end;

var
AMessage: TMsg;
hWindow: HWnd;

begin
if not WinRegister then
begin
MessageBox(0, 'Register Failed', nil, mb_Ok);
Exit;
end;

hWinDow := WinCreate;

if (Longint(hWindow) = 0 ) then
begin
MessageBox(0, 'WinCreate Failed', nil, mb_Ok);
Exit;
end;

While GetMessage(AMessage, 0, 0, 0) do
begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;

Halt(AMessage.wParam);
end.

二.面向对象改造：

DELPHI 开发原生WINDOW窗口程序(面向对象)
1.定义消息结构体TMessage(系统)
2.定义消息回调函数 WndProc
3.注册窗口信息到WINDOWS中(用到回调函数地址)
4.CreateWindow创建窗口
5.消息循环处理

program Project2;

uses
Windows,
Messages,
SysUtils;

const
AppName ='PascalHello';

Type
TMyWindow = Class(TObject)
private
    WindowClass: WndClass;
    hWindow: HWnd;
    AMessage: TMsg;
    function Winregister : Boolean;
    procedure CreateMyWindow;
public
    FAppName: String;
    FWndProc: TFNWndProc;

constructor Create;
destructor Destroy; override;

procedure WinCreate;
procedure MyRun;

property ApplicationName : string read FAppName;
property WindowProcedure : TFNWndProc read FWndProc;

end;

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, '使用PASCAL撰写的NATIVE WINDOW程序，利用面向对象技术进行编程。', -1, r,
          DT_SINGLELINE or DT_CENTER or DT_VCENTER);
        EndPaint(Window, ps);
        Exit;
      end;
    WM_Destroy:
      begin
        PostQuitMessage(0);
      end;
    WM_LBUTTONDOWN:
      begin
        MessageBox(0, 'LBUTTONDOWN Click.', nil, mb_Ok);
      end;
    end;

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

var
MyWindow : TMyWindow;

{ TMyWindow }

constructor TMyWindow.Create;
begin

end;

destructor TMyWindow.Destroy;
begin

inherited;
end;

procedure TMyWindow.CreateMyWindow;
begin
hWindow := CreateWindow(AppName, 'Hell0 world Object Pascal Program',
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.MyRun;
begin
While GetMessage(AMessage, 0, 0, 0) do
begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;

Halt(AMessage.wParam);
end;

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

function TMyWindow.Winregister: Boolean;
begin
WindowClass.style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := TFNWndProc(@WindowProc);
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 := AppName;

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

begin
MyWindow := TMyWindow.Create;
MyWindow.FAppName := AppName;
MyWindow.FWndProc := TFNWndProc(@WindowProc);
MyWindow.WinCreate;

try
MyWindow.MyRun;
finally
FreeAndNil(MyWindow);
end;
end.