Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Переключение консольного приложения в полный экран

- Алло!!! Я у вас купил компьютер и он сдох, а была пожизненая гарантия?!
- Ну все - гарантия кончилась...


{ 
   There is no documented way to make a console application fullscreen. 
   The following code works for both NT and Win9x. 
   For win NT I used the undocumented SetConsoleDisplayMode and 
   GetConsoleDisplayMode functions. 
} 

{ 
 function GetConsoleDisplayMode(var lpdwMode: DWORD): BOOL; stdcall; 
   external 'kernel32.dll'; 
  // lpdwMode: address of variable for current value of display mode 
} 

function NT_GetConsoleDisplayMode(var lpdwMode: DWORD): Boolean; 
type 
  TGetConsoleDisplayMode = function(var lpdwMode: DWORD): BOOL; 
  stdcall; 
var 
  hKernel: THandle; 
  GetConsoleDisplayMode: TGetConsoleDisplayMode; 
begin 
  Result := False; 
  hKernel := GetModuleHandle('kernel32.dll'); 
  if (hKernel > 0) then 
  begin @GetConsoleDisplayMode := 
      GetProcAddress(hKernel, 'GetConsoleDisplayMode'); 
    if Assigned(GetConsoleDisplayMode) then 
    begin 
      Result := GetConsoleDisplayMode(lpdwMode); 
    end; 
  end; 
end; 

{ 
  function SetConsoleDisplayMode(hOut: THandle; // standard output handle 
  dwNewMode: DWORD;         // specifies the display mode 
  var lpdwOldMode: DWORD    // address of variable for previous value of display mode 
  ): BOOL; stdcall; external 'kernel32.dll'; 
} 

function NT_SetConsoleDisplayMode(hOut: THandle; dwNewMode: DWORD; 
  var lpdwOldMode: DWORD): Boolean; 
type 
  TSetConsoleDisplayMode = function(hOut: THandle; dwNewMode: DWORD; 
  var lpdwOldMode: DWORD): BOOL; 
  stdcall; 
var 
  hKernel: THandle; 
  SetConsoleDisplayMode: TSetConsoleDisplayMode; 
begin 
  Result := False; 
  hKernel := GetModuleHandle('kernel32.dll'); 
  if (hKernel > 0) then 
  begin @SetConsoleDisplayMode := 
      GetProcAddress(hKernel, 'SetConsoleDisplayMode'); 
    if Assigned(SetConsoleDisplayMode) then 
    begin 
      Result := SetConsoleDisplayMode(hOut, dwNewMode, lpdwOldMode); 
    end; 
  end; 
end; 

function GetConsoleWindow: THandle; 
var 
  S: AnsiString; 
  C: Char; 
begin 
  Result := 0; 
  Setlength(S, MAX_PATH + 1); 
  if GetConsoleTitle(PChar(S), MAX_PATH) <> 0 then 
  begin 
    C := S[1]; 
    S[1] := '$'; 
    SetConsoleTitle(PChar(S)); 
    Result := FindWindow(nil, PChar(S)); 
    S[1] := C; 
    SetConsoleTitle(PChar(S)); 
  end; 
end; 

function SetConsoleFullScreen(bFullScreen: Boolean): Boolean; 
const 
  MAGIC_CONSOLE_TOGGLE = 57359; 
var 
  dwOldMode: DWORD; 
  dwNewMode: DWORD; 
  hOut: THandle; 
  hConsole: THandle; 
begin 
  if Win32Platform = VER_PLATFORM_WIN32_NT then 
  begin 
    dwNewMode := Ord(bFullScreen); 
    NT_GetConsoleDisplayMode(dwOldMode); 
    hOut := GetStdHandle(STD_OUTPUT_HANDLE); 
    Result := NT_SetConsoleDisplayMode(hOut, dwNewMode, dwOldMode); 
  end 
  else 
  begin 
    hConsole := GetConsoleWindow; 
    Result := hConsole <> 0; 
    if Result then 
    begin 
      if bFullScreen then 
      begin 
        SendMessage(GetConsoleWindow, WM_COMMAND, MAGIC_CONSOLE_TOGGLE, 0); 
      end 
      else 
      begin 
        // Better solution than keybd_event under Win9X ? 
        keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0); 
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), 0, 0); 
        keybd_event(VK_RETURN, MapVirtualKey(VK_RETURN, 0), KEYEVENTF_KEYUP, 0); 
        keybd_event(VK_MENU, MapVirtualKey(VK_MENU, 0), KEYEVENTF_KEYUP, 0); 
      end; 
    end; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
begin 
  AllocConsole; 
  try 
    SetConsoleFullScreen(True); 
    Write('Hi, you are in full screen mode now. Type something [Return]: '); 
    Readln(s); 
    SetConsoleFullScreen(False); 
    // ShowMessage(Format('You typed: "%s"', [s])); 
  finally 
    FreeConsole; 
  end; 
end;

Проект Delphi World © Выпуск 2002 - 2024
Автор проекта: USU Software
Вы можете выкупить этот проект.