Borland Delphi FAQ
Страница 8.



------------------------------------------------------------

Q-77:  Как центрировать по форме модальный диалог?

------------------------------------------------------------
procedure CenterDialogPos(DlgHandle, WindowHandle: HWND);
var
  DlgRect : TRect;
  WndRect : TRect;
  x, y, w, h : integer;
begin
  if (DlgHandle <> 0) then begin
    GetWindowRect(DlgHandle, DlgRect);
    GetWindowRect(WindowHandle, WndRect);
    w := DlgRect.Right - DlgRect.Left;
    h := DlgRect.Bottom - DlgRect.Top;
   
file://center horz
    x := WndRect.Left + ((WndRect.Right - WndRect.Left - w) div 2);
   
file://keep on screen
    if x < 0 then x := 0
    else if x + w > Screen.Width then x := Screen.Width - w;
   
file://center vert
    y := WndRect.Top + ((WndRect.Bottom - WndRect.Top - h) div 2);
   
file://keep on screen
    if y < 0 then  y := 0
    else if y + h > Screen.Height then  y := Screen.Height - h;
    SetWindowPos(DlgHandle, 0, x, y, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or
SWP_NOZORDER);
  end;
end;

procedure TForm1.WMUser1(var msg: TMessage); // message WM_USER+1;
begin
  CenterDialogPos(GetActiveWindow, Handle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PostMessage(Handle, WM_USER+1, 0, 0);
  ShowMessage('Test');
end;

------------------------------------------------------------

Q-78:  Как издать звук через PC Speaker?

------------------------------------------------------------
Procedure Sound(Duration: Integer; Freq: Word);
var
  Ver: TOsVersionInfo;
begin
  Ver.dwOSVersionInfoSize := SizeOf(Ver);
  GetVersionEx(Ver);
  if ver.dwPlatformId = VER_PLATFORM_WIN32_NT then
    Windows.Beep(Duration, Freq)
  else begin
    asm
      mov al,0b6H
      out 43H,al
      mov ax,Freq
      out 42h,al
      ror ax,8
      out 42h,al
      in  al,61H
      or  al,03H
      out 61H,al
    end;
    sleep(Duration);
    asm
      in  al,61H
      and al,0fcH
      out 61H,al
    end;
  end;
end;

------------------------------------------------------------

Q-79:  Как узнать версию Windows?

------------------------------------------------------------
Использовать функцию API GetVersionEx

function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;
stdcall;

Аргумент функции - структура TOSVersionInfo, содержит
DwVersionInfoSize:DWORD -
заполняется как sizeof TOSVersionInfo) перед
вызовом функции

DwMajorVersion:DWORD -
старшая цифра версии Windows
  Windows 95      - 4
  Windows 98      - 4
  Windows Me      - 4
  Windows NT 3.51 - 3
  Windows NT 4.0  - 4
  Windows 2000    - 5
  Windows XP      - 5

DwMinorVersion: DWORD -
младшая цифра версии
  Windows 95      - 0
  Windows 98      - 10
  Windows Me      - 90
  Windows NT 3.51 - 51
  Windows NT 4.0  - 0
  Windows 2000    - 0
  Windows XP      - 1

DwBuildNumber: DWORD
 Win NT 4 -
номер билда
 Win 9x   -
старший байт - старшая и младшая цифры версии / младший - номер
билда

dwPlatformId: DWORD
 VER_PLATFORM_WIN32s            Win32s on Windows 3.1.
 VER_PLATFORM_WIN32_WINDOWS     Win32 on Windows 9x
 VER_PLATFORM_WIN32_NT          Win32 on Windows NT, 2000

SzCSDVersion:DWORD
  NT -
содержит PСhar с инфо о установленном ServicePack
  9x -
доп. инфо, может и не быть

Alexander Kramarenko <
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script >

------------------------------------------------------------

Q-80:  Как из dll узнать узнать полный путь к этой dll.

------------------------------------------------------------
function GetModuleFileNameStr(Instance: THandle): String;
var
  buffer : array [0..MAX_PATH] of Char;
begin
  GetModuleFileName( Instance, buffer, MAX_PATH);
  Result := buffer;
end;

   GetModuleFileNameStr(Hinstance); // dll name
   GetModuleFileNameStr(0); // exe name

Leonid Troyanovsky <
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script >

------------------------------------------------------------

Q-81:  Как узнать кол-во цветов цветовой палитры?

------------------------------------------------------------
function GetColorsCount : DWord;
var
  DC : HDC;
begin
  DC := GetDC( 0 );
  Win32Check(DC <> 0);
  Result :=1 shl (GetDeviceCaps(DC, PLANES) *
                  GetDeviceCaps(DC, BITSPIXEL));
  ReleaseDC( 0, DC );
end;

Leonid Troyanovsky <
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script >

------------------------------------------------------------

Q-82:  Как заставить мигать кнопку приложения на AppBar?

------------------------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FlashWindow(Application.Handle, True);
end;

Leonid Troyanovsky <
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script >

 
« Предыдущая статья   Следующая статья »