Recent Posts
Selamat datang di Coding Delphi Land Weblog kumpulan source code pemogram delphi
(Bukan maksud untuk menggurui tetapi marilah kita berbagi ilmu tuk perkembangan kemajuan teknologi kita
Selasa, 26 September 2017
Create New Windows
unit CreateAWindowu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ Register the Window Class }
function RegisterClass: Boolean;
var
WindowClass: TWndClass;
begin
{setup our new window class}
WindowClass.Style := CS_HREDRAW or CS_VREDRAW; {set the class styles}
WindowClass.lpfnWndProc := @DefWindowProc; {point to the default window procedure}
WindowClass.cbClsExtra := 0; {no extra class memory}
WindowClass.cbWndExtra := 0; {no extra window memory}
WindowClass.hInstance := hInstance; {the application instance}
WindowClass.hIcon := 0; {no icon specified}
WindowClass.hCursor := 0; {no cursor specified}
WindowClass.hbrBackground := COLOR_WINDOW; {use a predefined color}
WindowClass.lpszMenuName := nil; {no menu}
WindowClass.lpszClassName := 'TestClass'; {the registered class name}
{now that we have our class set up, register it with the system}
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hWindow: HWND;
begin
{Step 1: Register our new window class}
if not RegisterClass then
begin
ShowMessage('RegisterClass failed');
Exit;
end;
{Step 2: Create a window based on our new class}
hWindow := CreateWindow('TestClass', {the registered class name}
'New Window', {the title bar text}
WS_OVERLAPPEDWINDOW, {a normal window style}
CW_USEDEFAULT, {default horizontal position}
CW_USEDEFAULT, {default vertical position}
CW_USEDEFAULT, {default width}
CW_USEDEFAULT, {default height}
0, {no owner window}
0, {no menu}
hInstance, {the application instance}
nil {no additional information}
);
{Step 3: If our window was created successfully, display it}
if hWindow <> 0 then
begin
ShowWindow(hWindow, SW_SHOWNORMAL);
UpdateWindow(hWindow);
end
else
begin
ShowMessage('CreateWindow failed');
Exit;
end;
end;
end.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ Register the Window Class }
function RegisterClass: Boolean;
var
WindowClass: TWndClass;
begin
{setup our new window class}
WindowClass.Style := CS_HREDRAW or CS_VREDRAW; {set the class styles}
WindowClass.lpfnWndProc := @DefWindowProc; {point to the default window procedure}
WindowClass.cbClsExtra := 0; {no extra class memory}
WindowClass.cbWndExtra := 0; {no extra window memory}
WindowClass.hInstance := hInstance; {the application instance}
WindowClass.hIcon := 0; {no icon specified}
WindowClass.hCursor := 0; {no cursor specified}
WindowClass.hbrBackground := COLOR_WINDOW; {use a predefined color}
WindowClass.lpszMenuName := nil; {no menu}
WindowClass.lpszClassName := 'TestClass'; {the registered class name}
{now that we have our class set up, register it with the system}
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hWindow: HWND;
begin
{Step 1: Register our new window class}
if not RegisterClass then
begin
ShowMessage('RegisterClass failed');
Exit;
end;
{Step 2: Create a window based on our new class}
hWindow := CreateWindow('TestClass', {the registered class name}
'New Window', {the title bar text}
WS_OVERLAPPEDWINDOW, {a normal window style}
CW_USEDEFAULT, {default horizontal position}
CW_USEDEFAULT, {default vertical position}
CW_USEDEFAULT, {default width}
CW_USEDEFAULT, {default height}
0, {no owner window}
0, {no menu}
hInstance, {the application instance}
nil {no additional information}
);
{Step 3: If our window was created successfully, display it}
if hWindow <> 0 then
begin
ShowWindow(hWindow, SW_SHOWNORMAL);
UpdateWindow(hWindow);
end
else
begin
ShowMessage('CreateWindow failed');
Exit;
end;
end;
end.
0 komentar:
Posting Komentar