was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1547)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (127)
Strings (83)
System (268)
VCL (243)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

39 Visitors Online


 
...eine Konsole in den Vollbildmodus setzen?
Autor: Thomas Stutz
[ Tip ausdrucken ]  

Tip Bewertung (10):  
     


{
   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.
}


{
   Es gibt dokumentierte Möglichkeit, eine Konsolen-Anwendung per Code
   in den Vollbild Modus zu setzen.
   Folgender Code funktioniert unter NT und Win9x.
   Unter NT werden die undokumentierten SetConsoleDisplayMode und
   GetConsoleDisplayMode Funktion verwendet.
}

{
 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;


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners