Programa

program LittleApplication;

uses
  uMain in 'uMain.pas';

begin
  Iniciar;
end.

//////////
unit uAPI;

interface

type
  //--ATENÇÃO
  //Quando você lê o msdn, recebemos os tipos das váriaves em c, para melhor compreensão da leitura dessa documentação
  //leia antes http://delphi.about.com/od/windowsshellapi/l/aa101303a.htm

  //Para criar uma janela precisamos utilizar um record que é passado como parametro para a api contendo
  //as informações do form, segue os parametros http://msdn.microsoft.com/en-us/library/aa925944.aspx
  TMW_WndClass = packed record
    Style         : LongWord;        //UINT style;
    LPFnWndProc   : Pointer;         //WNDPROC lpfnWndProc;
    CBClsExtra    : integer;         //int cbClsExtra;
    CBWndExtra    : integer;         // int cbWndExtra;
    HInstance     : THandle;         //HANDLE hInstance;
    HIcon         : LongWord;        //HICON hIcon;
    HCursor       : LongWord;        //HCURSOR hCursor;
    HBrBackground : LongWord;        //HBRUSH hbrBackground;
    LPSZMenuName  : PAnsiChar;       //LPCTSTR lpszMenuName;
    LPSZClassName : PAnsiChar;       //LPCTSTR lpszMenuName;
  end;

  TPoint = packed record
    X: Longint;
    Y: Longint;
  end;
  
  TMSG = packed record
    hwnd: LongWord;
    message: Longint;
    wParam: Longint;
    lParam: Longint;
    time: LongWord;
    pt: TPoint;
  end;

  procedure Sleep(dwMilliseconds: LongWord); stdcall;
  function CreateWindowEx(dwExStyle: Longint; lpClassName: PChar; lpWindowName: PChar; dwStyle: Longint;
    X, Y, nWidth, nHeight: Integer; hWndParent: THandle; hMenu: LongWord;
    hInstance: HINST; lpParam: Pointer): THandle; stdcall;

  function ShowWindow(hWnd: LongWord; nCmdShow: Integer): Boolean; stdcall;
  function RegisterClass(const lpWndClass: TMW_WndClass): Word; stdcall;
  function TranslateMessage(const lMsg: TMSG): Boolean; stdcall;
  function DispatchMessage(const lMsg: TMSG): Longint; stdcall;
  function GetMessage(var lMsg: TMSG; HWnd: LongWord; WMsgFilterMin, WMsgFilterMax: Longint): Boolean; stdcall;
  function DefWindowProc(HWnd: LongWord; Msg: Longint; WParam: Longint; LParam: Longint): LongInt; stdcall;
  procedure PostQuitMessage(lExitCode: Longint); stdcall;
  
const
  //Bibliotecas do windows
  user32 = 'user32.dll';
  kernel32 = 'kernel32.dll';

  //Algumas dos valores de constantes requisitadas para compor o packed record é declado na unit WINUSER.H, que é
  //default e disponibilizada pela microsoft, segue um link de referência http://www.woodmann.com/fravia/sources/WINUSER.H
  CS_DBLCLKS  = $008; //#define CS_DBLCLKS  0x0008
  CS_HREDRAW  = $002; //#define CS_HREDRAW  0x0002
  CS_NOCLOSE  = $200; //#define CS_NOCLOSE  0x0200
  CS_PARENTDC = $080; //#define CS_PARENTDC 0x0080
  CS_VREDRAW  = $001; //#define CS_VREDRAW  0x0001
  CS_OWNDC    = $020;  //#define CS_OWNDC   0x0020 Exeplicação dessa flag http://blogs.msdn.com/b/oldnewthing/archive/2006/06/01/612970.aspx


  WS_OVERLAPPED   = 0;        //#define WS_OVERLAPPED       0x00000000L
  WS_CAPTION      = $C00000;  //#define WS_CAPTION          0x00C00000L
  WS_SYSMENU      = $80000;   //#define WS_SYSMENU          0x00080000L
  WS_THICKFRAME   = $40000;   //#define WS_THICKFRAME       0x00040000L
  WS_MINIMIZEBOX  = $20000;   //#define WS_MINIMIZEBOX      0x00020000L
  WS_MAXIMIZEBOX  = $10000;   //#define WS_MAXIMIZEBOX      0x00010000L
  WS_VISIBLE      = $10000000;
  WS_CHILD        = $40000000;
  WS_OVERLAPPEDWINDOW = WS_OVERLAPPED or WS_CAPTION or WS_SYSMENU or WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX;
  
  //BUTTON STYLE
  BS_PUSHBUTTON   = 0;
  BS_TEXT         = 0;


  WM_DESTROY = $0002;

  SW_HIDE = 0;
  SW_SHOWNORMAL = 1;
  SW_NORMAL = 1;
  SW_SHOWMINIMIZED = 2;
  SW_SHOWMAXIMIZED = 3;
  SW_MAXIMIZE = 3;
  SW_SHOWNOACTIVATE = 4;
  SW_SHOW = 5;
  SW_MINIMIZE = 6;
  SW_SHOWMINNOACTIVE = 7;
  SW_SHOWNA = 8;
  SW_RESTORE = 9;
  SW_SHOWDEFAULT = 10;

var
  SetWindowTheme: function(hwnd: THandle; pszSubAppName: PAnsiChar; pszSubIdList: PAnsiChar): THandle; stdcall;

implementation
  {Cria uma janela com as caracteristicas passadas por parametro.
   Ref. http://msdn.microsoft.com/en-us/library/ms632680(VS.85).aspx}
  function CreateWindowEx(dwExStyle: Longint; lpClassName: PChar; lpWindowName: PChar; dwStyle: Longint;
    X, Y, nWidth, nHeight: Integer; hWndParent: THandle; hMenu: LongWord;
    hInstance: HINST; lpParam: Pointer): THandle; stdcall; external user32 name 'CreateWindowExA';

  {Faz com que o contexto que chama o sleep fique em espera por X ms.
   Ref. http://msdn.microsoft.com/en-us/library/ms686298(VS.85).aspx}
  procedure Sleep; external kernel32 name 'Sleep';

  {Especifica o estado de visibilidade da janela.
   Ref. http://msdn.microsoft.com/en-us/library/ms633548(VS.85).aspx}
  function ShowWindow; external user32 name 'ShowWindow';

  {Registra uma classe do tipo Form, para que a mesma possa ser chamada posteriormente pelo CreateWindowEx.
   Ref. http://msdn.microsoft.com/en-us/library/ms633586(VS.85).aspx}
  function RegisterClass; external user32 name 'RegisterClassA';

  {Traduz mensagens de teclas virtuais para teclas de caracter
    Ref. http://msdn.microsoft.com/en-us/library/ms644955(VS.85).aspx}
  function TranslateMessage(const lMsg: TMSG): Boolean; stdcall; external user32 name 'TranslateMessage';

  {Dispacha uma mensagem para um procedimento de um form
    Ref. http://msdn.microsoft.com/en-us/library/ms644934(VS.85).aspx} 
  function DispatchMessage(const lMsg: TMSG): Longint; stdcall; external user32 name 'DispatchMessageA';

  {Pega a mensagem preparada para ser processadas.
    Ref. http://msdn.microsoft.com/en-us/library/ms644936(VS.85).aspx}
  function GetMessage(var lMsg: TMSG; HWnd: LongWord; WMsgFilterMin, WMsgFilterMax: Longint): Boolean; stdcall; external user32 name 'GetMessageA';

  {Caso o handle em questão não tenha tratamento para a mensagem que deve ser processada, chama o DefWindowsProc, para que a mensagem
   possa ser tratada com o procedimento padrão do SO.
   Ref. http://msdn.microsoft.com/en-us/library/ms633572(VS.85).aspx}
  function DefWindowProc(HWnd: LongWord; Msg: Longint; WParam: Longint; LParam: Longint): LongInt; stdcall; external user32 name 'DefWindowProcA';

  {Avisa que a aplicação pediu uma requisição para fechar.
    Ref. http://msdn.microsoft.com/en-us/library/ms644945(VS.85).aspx} 
  procedure PostQuitMessage(lExitCode: Longint); stdcall; external user32 name 'PostQuitMessage';

  function LoadLibrary(lpLibFileName: PChar): THandle; stdcall; external kernel32 name 'LoadLibraryA';
  function GetProcAddress(hModule: THandle; lpProcName: PAnsiChar): Pointer; stdcall; external kernel32 name 'GetProcAddress';

  procedure InitThemeControl;
  const
    themelib = 'uxtheme.dll';
  var
    ThemeLibrary: THandle;
  begin
    ThemeLibrary := LoadLibrary(themelib);
    SetWindowTheme := GetProcAddress(ThemeLibrary, 'SetWindowTheme');
  end;

initialization
  InitThemeControl;


end.
//////////////////
unit uMain;

interface
  procedure Iniciar;
  procedure ManterRodando;

var
  HFormPrincipal: THandle;

implementation

uses
  uAPI;

function EventsListener(AHWnd: LongWord; AMsg: Longint; AWParam: Longint; ALParam: Longint): Longint; stdcall;
begin
  Result := 0;
  case AMsg of
    WM_DESTROY: PostQuitMessage(0);
  end;
  Result := DefWindowProc(AHWnd,AMsg,AWParam,ALParam);
end;

procedure CriarJanela;
var
  LFormPrincipal: TMW_WndClass;
begin
  LFormPrincipal.HInstance := HInstance;
  with LFormPrincipal do
  begin
    Style := CS_DBLCLKS or CS_OWNDC;
    LPFnWndProc := @EventsListener;
    CBClsExtra := 0;
    CBWndExtra := 0;
    HIcon := 0;
    HCursor := 0;
    HBrBackground := 16;
    LPSzMenuName := nil;
    LPSzClassName := 'uFormPrincipal';
  end;

  if RegisterClass(LFormPrincipal) > 0 then
    HFormPrincipal := CreateWindowEx(0,LFormPrincipal.lpszClassName,'Janela Principal',WS_OVERLAPPEDWINDOW,0,0,386,250,0,0,hInstance,nil);

  CreateWindowEx(0,'BUTTON','Text',WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,12,42,60,26,HFormPrincipal,0,hInstance,nil);

  ShowWindow(HFormPrincipal, SW_NORMAL);
end;

procedure Iniciar;
begin
  CriarJanela;
  ManterRodando;
end;

procedure ManterRodando;
var
  LMsg: TMSG;
begin
  //Enquanto tiver mensagem recebendo, traduz e manda para o procedimento responsável.
  while GetMessage(LMsg, 0, 0, 0) do
  begin
    TranslateMessage(LMsg);
    DispatchMessage(LMsg);
  end;
end;

end.