Delphiで小さな実行ファイルを作ろう

program Window1;
uses
　Windows,
　Messages;
const　AppName = 'Window1';
type TMiniWin=class
private
　wATM　　　 : ATOM　　　 ;//RegisterClassの返すアトム
　WindowClass: TWndClassEx;
　hWindow: HWnd;
protected
　procedure WndProc(var Message: TMessage);virtual;
　procedure WMPaint(var Message: TWMPaint); message WM_PAINT;


function WinRegister: Boolean;
function WinCreate　: Boolean;
public
procedure DefaultHandler(var Message); override;
constructor Create; virtual;
function Show:Boolean;virtual;
end;

function WindowProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall; export;
var msg:TMessage;
begin
　msg.Msg :=AMessage; msg.LParam:=LParam ; msg.WParam:=WParam;msg.Result:=0;
　TMiniWin(GetWindowLong( Window,GWL_USERDATA) ).WndProc(msg);
　Result:=msg.Result;
end;

procedure TMiniWin.WndProc(var Message: TMessage);
begin　 Dispatch(Message); //メッセージをディスパッチします
end;
procedure TMiniWin.DefaultHandler(var Message );
begin　 with TMessage(Message ) do
　Result:=DefWindowProc(hWindow,Msg, wParam, lParam);
end;

function TMiniWin.WinRegister: Boolean;
begin
　with WindowClass do
　begin
　　cbSize:=SizeOf(WindowClass);
　　Style:=cs_hRedraw or cs_vRedraw;
　　lpfnWndProc:=@DefWindowProc;
　　cbClsExtra:=0;
　　cbWndExtra:=0;
　　hInstance:=HInstance;
　　hIcon:=LoadIcon(0, idi_Application);
　　hCursor:=LoadCursor(0, idi_Application);
　　hbrBackground:=HBrush(Color_Window);
　　lpszMenuName:=nil;
　　lpszClassName:=PChar(AppName);
　　hIconSm:=0;
　end;
　wATM:=RegisterClassEx(WindowClass);
　Result:=wATM <>0;
//　if not Result then　 MessageBox(0, PChar(SysErrorMessage(getLastError)), nil, mb_Ok);
end;

function TMiniWin.WinCreate: Boolean;
begin　　Result:=false;
if wATM=0 then if not WinRegister　then exit;
　hWindow:=CreateWindow({PChar(AppName)}PChar(wATM), PChar('ObjectPascalWindow'),
　　　　　　　　　　　　ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
　　　　　　　　　　　　cw_UseDefault, cw_UseDefault, 0, 0, HInstance, nil);
　Result:=hWindow<>0;
　if Result then　begin
　SetWindowLong( hWindow,GWL_WNDPROC ,integer(@WindowProc));
　SetWindowLong( hWindow,GWL_USERDATA　 ,integer(self));
　end;
end;

function TMiniWin.Show:boolean;
begin
Result:=False;　if hWindow=0 then　if not WinCreate then exit;
　 Result:= ShowWindow(hWindow, CmdShow);
　　Updatewindow(hWindow);
end;

constructor TMiniWin.Create;
begin　　inherited
end;

procedure TMiniWin.WMPaint(var Message: TWMPaint);
var h:HDC;
var ps:PAINTSTRUCT;
　procedure textOut(x,y:Integer;s:string);begin Windows.TextOut(h,x,y,PChar(s),Length(s)); end ;
begin
　h:=BeginPaint(hWindow,ps);
　 textOut(10,10,'こんにちは');
　EndPaint(hWindow,ps);
end;

procedure RunMessageLoop;
var　AMessage: TMsg;
begin
　while GetMessage(AMessage, 0, 0, 0) do
　begin
　　TranslateMessage(AMessage);
　　DispatchMessage(AMessage);
　end;
end;
///////// main /////////
var MiniWin:TMiniWin;
begin
　MiniWin:=TMiniWin.Create;
　MiniWin.Show;
　RunMessageLoop
end.