Exemplo de criação de uma aplicação simples usando apenas chamadas de api puras. Eu também crio um ToolTip que aparece em cima de dois botões que existem na janela. O Tooltip que aparece no botão nomeado "nada" tem o flag TTF_CENTERTIP que funciona perfeitamente, ao contrário do que acontece numa aplicação vcl, onde o uso deste flag faz com que o balão do ToolTip volte a ter o estilo do Windows XP

形式
Delphi
投稿日時
2022-03-26 10:37
公開期間
無期限
  1. program Project3;
  2. {$R 'resources.res' 'resources.rc'}
  3. uses
  4. Windows, Messages, CommCtrl;
  5. const
  6. IDC_BUTTON1 = 10;
  7. IDC_BUTTON2 = 11;
  8. function WndProc(AHwnd: HWND; AMessage: UINT; AWParam: WPARAM; ALParam: LPARAM): LRESULT; stdcall;
  9. begin
  10. Result := 0;
  11. case AMessage of
  12. WM_CREATE: begin
  13. var HwndButton1: HWND := CreateWindowEx(0, 'Button', 'Beep', WS_CHILD or WS_VISIBLE or BS_PUSHLIKE, 100, 100, 60, 32, AHwnd, IDC_BUTTON1, HInstance, nil);
  14. var HwndButton2: HWND := CreateWindowEx(0, 'Button', 'Nada', WS_CHILD or WS_VISIBLE or BS_PUSHLIKE, 200, 100, 60, 32, AHwnd, IDC_BUTTON2, HInstance, nil);
  15. 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);
  16. if HwndToolTip <> 0 then
  17. begin
  18. SendMessage(HwndToolTip, TTM_SETTITLE, TTI_INFO, LPARAM(PChar('Title')));
  19. SendMessage(HwndToolTip, TTM_SETMAXTIPWIDTH, 0, 300);
  20. var TI: TToolInfo;
  21. ZeroMemory(@TI,SizeOf(TToolInfo));
  22. TI.cbSize := SizeOf(TToolInfo);
  23. TI.hwnd := AHwnd;
  24. TI.uId := HwndButton1;
  25. 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.';
  26. TI.uFlags := TTF_IDISHWND or TTF_SUBCLASS;
  27. SendMessage(HwndToolTip, TTM_ADDTOOL, 0, LPARAM(@TI));
  28. TI.uId := HwndButton2;
  29. 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.';
  30. ti.uFlags := TTF_IDISHWND or TTF_SUBCLASS or TTF_CENTERTIP;
  31. SendMessage(HwndToolTip, TTM_ADDTOOL, 0, LPARAM(@TI));
  32. end;
  33. end;
  34. WM_COMMAND: begin
  35. var Id: Word := LOWORD(AWParam);
  36. var Event: Word := HIWORD(AWParam);
  37. case Id of
  38. IDC_BUTTON1: begin
  39. if Event = BN_CLICKED then
  40. Beep(1500,20);
  41. end;
  42. else
  43. Result := DefWindowProc(AHwnd,AMessage,AWParam,ALParam);
  44. end;
  45. end;
  46. WM_DESTROY: begin
  47. PostQuitMessage(0);
  48. end;
  49. else
  50. Result := DefWindowProc(AHwnd,AMessage,AWParam,ALParam);
  51. end;
  52. end;
  53. // No pascal o WinMain é bloco begin..end do arquivo dpr
  54. begin
  55. var WndClassEx: TWndClassEx;
  56. WndClassEx.cbSize := SizeOf(TWndClassEx);
  57. WndClassEx.style := CS_HREDRAW or CS_VREDRAW;
  58. WndClassEx.lpfnWndProc := @WndProc;
  59. WndClassEx.cbClsExtra := 0;
  60. WndClassEx.cbWndExtra := 0;
  61. WndClassEx.hInstance := HInstance;
  62. WndClassEx.hIcon := LoadIcon(0, IDI_APPLICATION);
  63. WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);
  64. WndClassEx.hbrBackground := COLOR_BTNFACE + 1;
  65. WndClassEx.lpszMenuName := nil;
  66. WndClassEx.lpszClassName := 'WindowClass';
  67. WndClassEx.hIconSm := 0;
  68. if RegisterClassEx(WndClassEx) = 0 then
  69. Halt(MessageBox(0,'Não foi possível registrar a classe!','Erro',MB_ICONERROR))
  70. else
  71. begin
  72. var Width: Word := 400;
  73. var Height: Word := 300;
  74. var X: Word := (GetSystemMetrics(SM_CXSCREEN) - Width) div 2;
  75. var Y: Word := (GetSystemMetrics(SM_CYSCREEN) - Height) div 2;
  76. var MainWnd: HWND := CreateWindowEx(0, WndClassEx.lpszClassName, 'Test', WS_OVERLAPPEDWINDOW, X, Y, Width, Height, 0, 0, HInstance, nil);
  77. if MainWnd = 0 then
  78. Halt(MessageBox(0,'Não foi possível criar a janela!','Erro',MB_ICONERROR))
  79. else
  80. begin
  81. ShowWindow(MainWnd,SW_SHOWNORMAL);
  82. UpdateWindow(MainWnd);
  83. var Msg: TMsg;
  84. // Main Loop :)
  85. while GetMessage(Msg,0,0,0) do
  86. begin
  87. TranslateMessage(Msg);
  88. DispatchMessage(Msg);
  89. end;
  90. ExitCode := Msg.wParam;
  91. end;
  92. end;
  93. (*
  94. Adicionalmente, para que este exemplo compile e rode como deve, execute os
  95. passos a seguir
  96. 1. Crie um arquivo de nome resources.rc com o conteúdo a seguir
  97. #define MANIFEST_RESOURCE_ID 1
  98. #define RT_MANIFEST 24
  99. MANIFEST_RESOURCE_ID RT_MANIFEST "manifest.xml"
  100. 2. Crie um arquivo de nome manifest.xml com o conteúdo a seguir
  101. <?xml version="1.0" encoding="UTF-8" standalone="yes"?>
  102. <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
  103. <asmv3:application>
  104. <asmv3:windowsSettings>
  105. <dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true/pm</dpiAware>
  106. <dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>
  107. </asmv3:windowsSettings>
  108. </asmv3:application>
  109. <dependency>
  110. <dependentAssembly>
  111. <assemblyIdentity
  112. type="win32"
  113. name="Microsoft.Windows.Common-Controls"
  114. version="6.0.0.0"
  115. publicKeyToken="6595b64144ccf1df"
  116. language="*"
  117. processorArchitecture="*"/>
  118. </dependentAssembly>
  119. </dependency>
  120. <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
  121. <security>
  122. <requestedPrivileges>
  123. <requestedExecutionLevel
  124. level="asInvoker"
  125. uiAccess="false"
  126. />
  127. </requestedPrivileges>
  128. </security>
  129. </trustInfo>
  130. <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
  131. <application>
  132. <!--The ID below indicates app support for Windows Vista -->
  133. <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
  134. <!--The ID below indicates app support for Windows 7 -->
  135. <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
  136. <!--The ID below indicates app support for Windows 8 -->
  137. <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
  138. <!--The ID below indicates app support for Windows 8.1 -->
  139. <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
  140. <!--The ID below indicates app support for Windows 10 -->
  141. <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
  142. </application>
  143. </compatibility>
  144. </assembly>
  145. 3. Coloque os dois arquivos criados na mesma pasta onde se encontra este arquivo
  146. .dpr
  147. *)
  148. end.
ダウンロード 印刷用表示

このコピペの URL

JavaScript での埋め込み

iframe での埋め込み

元のテキスト