コピペ: Exemplo de criação de uma aplicação simples usando apenas chamadas de api puras

形式

Delphi

投稿日時

2022-03-26 10:37

公開期間

無期限

 program Project3;
 
 {$R 'resources.res' 'resources.rc'}
 
 uses
   Windows, Messages, CommCtrl;
 
 const
   IDC_BUTTON1 = 10;
   IDC_BUTTON2 = 11;
 
 function WndProc(AHwnd: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
 begin
   Result := 0;
 
   case AMessage of
     WM_CREATE: begin
       var HwndButton1: HWND := CreateWindowEx(0, 'Button', 'Beep', WS_CHILD or WS_VISIBLE or BS_PUSHLIKE, 100, 100, 60, 32, AHwnd, IDC_BUTTON1, HInstance, nil);
       var HwndButton2: HWND := CreateWindowEx(0, 'Button', 'Nada', WS_CHILD or WS_VISIBLE or BS_PUSHLIKE, 200, 100, 60, 32, AHwnd, IDC_BUTTON2, HInstance, nil);
       var HwndToolTip: HWND := CreateWindowEx(WS_EX_NOACTIVATE or WS_EX_TOPMOST,TOOLTIPS_CLASS,nil,TTS_ALWAYSTIP or TTS_BALLOON, 0, 0, 0, 0, AHwnd, 0, HInstance, nil);
 
       if HwndToolTip <> 0 then
       begin
         SendMessage(HwndToolTip, TTM_SETTITLE, TTI_INFO, LPARAM(PChar('Title')));
         SendMessage(HwndToolTip, TTM_SETMAXTIPWIDTH, 0, 300);
 
         var TI: TToolInfo;
         ZeroMemory(@TI,SizeOf(TToolInfo));
 
         TI.cbSize := SizeOf(TToolInfo);
         TI.hwnd := AHwnd;
 
         TI.uId := HwndButton1;
         TI.lpszText := 'Lorem ipsum dolor sit amet, consectetur adipiscing elit. Quisque tincidunt dictum dui vel luctus. Duis ornare arcu a varius pharetra. Curabitur tempor sit amet dui id malesuada. Aliquam efficitur, massa consectetur tristique iaculis, dolor diam tincidunt.';
         TI.uFlags := TTF_IDISHWND or TTF_SUBCLASS;
         SendMessage(HwndToolTip, TTM_ADDTOOL, 0, LPARAM(@TI));
 
         TI.uId := HwndButton2;
         TI.lpszText := 'Lorem ipsum dolor sit amet, consectetur adipiscing elit. Quisque tincidunt dictum dui vel luctus. Duis ornare arcu a varius pharetra. Curabitur tempor sit amet dui id malesuada. Aliquam efficitur, massa consectetur tristique iaculis, dolor diam tincidunt.';
         ti.uFlags := TTF_IDISHWND or TTF_SUBCLASS or TTF_CENTERTIP;
         SendMessage(HwndToolTip, TTM_ADDTOOL, 0, LPARAM(@TI));
       end;
     end;
     WM_COMMAND: begin
       var Id: Word := LOWORD(AWParam);
       var Event: Word := HIWORD(AWParam);
 
       case Id of
         IDC_BUTTON1: begin
           if Event = BN_CLICKED then
             Beep(1500,20);
         end;
         else
           Result := DefWindowProc(AHwnd,AMessage,AWParam,ALParam);
       end;
     end;
     WM_DESTROY: begin
       PostQuitMessage(0);
     end;
     else
       Result := DefWindowProc(AHwnd,AMessage,AWParam,ALParam);
   end;
 end;
 // No pascal o WinMain é bloco begin..end do arquivo dpr
 begin
   var WndClassEx: TWndClassEx;
 
   WndClassEx.cbSize := SizeOf(TWndClassEx);
   WndClassEx.style := CS_HREDRAW or CS_VREDRAW;
   WndClassEx.lpfnWndProc := @WndProc;
   WndClassEx.cbClsExtra := 0;
   WndClassEx.cbWndExtra := 0;
   WndClassEx.hInstance := HInstance;
   WndClassEx.hIcon := LoadIcon(0, IDI_APPLICATION);
   WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);
   WndClassEx.hbrBackground := COLOR_BTNFACE + 1;
   WndClassEx.lpszMenuName := nil;
   WndClassEx.lpszClassName := 'WindowClass';
   WndClassEx.hIconSm := 0;
 
   if RegisterClassEx(WndClassEx) = 0 then
     Halt(MessageBox(0,'Não foi possível registrar a classe!','Erro',MB_ICONERROR))
   else
   begin
     var Width: Word := 400;
     var Height: Word := 300;
     var X: Word := (GetSystemMetrics(SM_CXSCREEN) - Width) div 2;
     var Y: Word := (GetSystemMetrics(SM_CYSCREEN) - Height) div 2;
 
     var MainWnd: HWND := CreateWindowEx(0, WndClassEx.lpszClassName, 'Test', WS_OVERLAPPEDWINDOW, X, Y, Width, Height, 0, 0, HInstance, nil);
 
     if MainWnd = 0 then
       Halt(MessageBox(0,'Não foi possível criar a janela!','Erro',MB_ICONERROR))
     else
     begin
       ShowWindow(MainWnd,SW_SHOWNORMAL);
       UpdateWindow(MainWnd);
 
       var Msg: TMsg;
 
       // Main Loop :)
       while GetMessage(Msg,0,0,0) do
       begin
         TranslateMessage(Msg);
         DispatchMessage(Msg);
       end;
 
       ExitCode := Msg.wParam;
     end;
   end;
 
 (*
 Adicionalmente, para que este exemplo compile e rode como deve, execute os
 passos a seguir
 
 1. Crie um arquivo de nome resources.rc com o conteúdo a seguir
 
 #define MANIFEST_RESOURCE_ID    1
 #define RT_MANIFEST             24
 MANIFEST_RESOURCE_ID RT_MANIFEST "manifest.xml"
 
 2. Crie um arquivo de nome manifest.xml com o conteúdo a seguir
 
 <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
 <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
   <asmv3:application>
     <asmv3:windowsSettings>
       <dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true/pm</dpiAware>
       <dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>
     </asmv3:windowsSettings>
   </asmv3:application>
   <dependency>
     <dependentAssembly>
       <assemblyIdentity
         type="win32"
         name="Microsoft.Windows.Common-Controls"
         version="6.0.0.0"
         publicKeyToken="6595b64144ccf1df"
         language="*"
         processorArchitecture="*"/>
     </dependentAssembly>
   </dependency>
   <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
     <security>
       <requestedPrivileges>
         <requestedExecutionLevel
           level="asInvoker"
           uiAccess="false"
         />
       </requestedPrivileges>
     </security>
   </trustInfo>
 <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
         <application>
                 <!--The ID below indicates app support for Windows Vista -->
                 <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
                 <!--The ID below indicates app support for Windows 7 -->
                 <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
                 <!--The ID below indicates app support for Windows 8 -->
                 <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
                 <!--The ID below indicates app support for Windows 8.1 -->
                 <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
                 <!--The ID below indicates app support for Windows 10 -->
                 <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
         </application>
 </compatibility>
 </assembly>
 
 3. Coloque os dois arquivos criados na mesma pasta onde se encontra este arquivo
    .dpr
 
 *)
 
 end.