System

Ermitteln der Mauskoordinaten

Weiß hier zufällig jemand, wie ich unter D3 die aktuellen Koordinaten des Mauszeigers abfragen kann? (Unabhängig davon, ob sich der Mauszeiger über meinem Formular oder irgendwo auf dem Desktop befindet und unabhängig von Mausereignissen)

Mit einer simplen API-Funktion:

GetCursorPos(var Koordinaten : TPoint);

und hier das Beispiel:

procedure GetMouseLocation;
var
  MousePosition : TPoint;
begin
  GetCursorPos(MousePosition);
  if MousePosition.x > 100 then
    Edit1.Text := 'Die Maus ist zuweit rechts...';
end;
Lustig ist auch SetCursorPos - damit gehts umgekehrt, allerdings sind da die Parameter anders:

procedure SetCursorPos(x, y: integer)

Wie ermittle ich das Betriebssystem (Win 9x/ME/NT/2000/XP) ?

Diese Funktionen demonstrieren den Gebrauch der API-Funktion "GetVersionEx":

type
  TWindowsVersion = (wvUnknown,
                     wvWin95, wvWin95OSR2, wvWin98, wvWin98SE, wvWinME, wvWinNT3, wvWinNT4, wvWin2000, wvWinXP);
//=================================================================================================================
// Win32Platform        1           1           1        1         1        2         2          2           2
// Win32MajorVersion    4           4           4        4         4        3         4          5           5
// Win32MinorVersion    0           0           10       10        90       ?         0          0           1
// Win32BuildNumber     ?        67109975    67766222  67766446  73010104   ?        1381       2195         ?
// Win32CSDVersion      ?          'B'          ''       A         SP       SP        SP         ?           ?

function GetWindowsVersion(var VerString:string): TWindowsVersion;
var osInfo : tosVersionInfo;
begin
  Result := wvUnknown;

  osInfo.dwOSVersionInfoSize:= Sizeof( osInfo );
  GetVersionEx( osInfo );

  with osInfo do begin
    VerString:='Version ' + IntToStr( osInfo.dwMajorVersion ) +
               '.' + IntToStr( osInfo.dwMinorVersion ) + ', Build ';

    case dwPlatformId of
      VER_PLATFORM_WIN32_WINDOWS : begin
        case dwMinorVersion of
          0 : if Trim(szCSDVersion[1]) = 'B' then
                Result:= wvWin95OSR2
              else
                Result:= wvWin95;
         10 : if Trim(szCSDVersion[1]) = 'A' then
                Result:= wvWin98SE
              else
                Result:= wvWin98;
         90 : if (dwBuildNumber = 73010104) then
                Result:= wvWinME;
        end;
        VerString:=VerString + IntToStr(LoWord( osInfo.dwBuildNumber ));
      end;
      VER_PLATFORM_WIN32_NT      : begin
        case dwMajorVersion of
          3 : Result:= wvWinNT3;
          4 : Result:= wvWinNT4;
          5 : case dwMinorVersion of
                0 : Result:= wvWin2000;
                1 : Result:= wvWinXP;
              end;
        end;
        VerString:=VerString + IntToStr(osInfo.dwBuildNumber );
      end;
    end;
  end;
end;

function GetOSName : string;
var
  osVerInfo : TOSVersionInfo;
  majorVer,
  minorVer  : Integer;
begin
  result := 'Unknown';
  osVerInfo.dwOSVersionInfoSize := Sizeof(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then begin
    majorVer := osVerInfo.dwMajorVersion;
    minorVer := osVerInfo.dwMinorVersion;
    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_NT : { Windows NT/2000 }
        begin
          if majorVer <= 4 then
            result := 'Windows NT'
          else if (majorVer = 5) and (minorVer= 0) then
            result := 'Windows 2000'
          else if (majorVer = 5) and (minorVer = 1) then
            result := 'Whistler'
          else
            result := 'Unknown';
        end;
      VER_PLATFORM_WIN32_WINDOWS :  { Windows 9x/ME }
        begin
          if (majorVer = 4) and (minorVer = 0) then
            result := ' Windows 95'
          else if (majorVer = 4) and (minorVer = 10) then begin
            if osVerInfo.szCSDVersion[1] = 'A' then
              result := 'Windows 98SE'
            else
              result := 'Windows 98';
          end
          else if (majorVer = 4) and (minorVer = 90) then
            result := 'Windows ME'
          else
            result := 'Unknown';
        end;
    else
      result := 'Unknown';
    end;
  end
  else
    result := 'Unknown';
end;

Wie ermittle ich die Taktfrequenz der CPU?

Diese Routine 'läuft' nur auf der Pentium-Klasse, aber dafür auf 1/100 MHz genau:

function GetCPUSpeed: Double;
const
  TimeOfDelay = 500;
// Zeitraum für die Messung
 var
  TimerHigh, TimerLow: DWORD;

begin
//  Prozess und Thread auf Maximum Priorität setzen
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);

// Timer Werte auslesen
  asm
// Read From Time Stamp Counter
    dw 310Fh
    mov TimerLow, eax
    mov TimerHigh, edx
  end;

  Sleep(TimeOfDelay);

// Timer-Differenz ermitteln
  asm
// Read From Time Stamp Counter
    dw 310Fh
    sub eax, TimerLow
    sbb edx, TimerHigh
    mov TimerLow,  eax
    mov TimerHigh, edx
  end;

  Result := TimerLow / (1000.0 * TimeOfDelay);
end;
Grundlagen: Interrupt List Release 52 von Ralf Brown

Wie ermittle ich verschiedene Systemparameter, wie Systemordner, Usernamen, etc.?

Die WinFuncs enthält verschiedene Funktionen zur Ermittlung folgender Systemparameter:

Zum Auslesen der Sytemverzeichnisse unter W2k sollte man SHGetFolderPath benutzen. Eine Delphi-Kapselung dieser API-Funktion und nähere Informationen dazu findet man auf der Internetseite von Peter Haas. Dort steht auch, wie man diese Funktion unter WinNT 4 verfügbar macht.

Viele weitere Einstellungen, wie Auflösung, Farbtiefe, Breite der Scrollbalken, etc. -d.h. alle Einstellungen, die man im "Eigenschaften"-Dialog des Desktops vornimmt- ermittelt man mit der API-Funktion "GetSystemMetrics".

Wie beendet man Windows vom eigenen Programm aus?

Dafür gibt es die Funktionen ExitWindows und ExitWindowsEx:

  ExitWindowsEx(EWX_LOGOFF,0);   (* Neuanmeldung *)
  ExitWindowsEx(EWX_REBOOT,0);   (* Windows neu starten *)
  ExitWindowsEx(EWX_SHUTDOWN,0); (* Windows herunterfahren *)

Wie kann man Systemzeit und -datum ändern?

Dafür gibt es die API-Funktion SetSystemTime. In diesem Beispiel wird das Datum auf den 19.08.1980 gesetzt und die Uhrzeit auf 08:19:10:000 h:

var TimeStruct : TSystemTime;

begin
  TimeStruct.wYear:=1980;
  TimeStruct.wMonth:=8;
  TimeStruct.wDay:=19;
  TimeStruct.wHour:=8;
  TimeStruct.wMinute:=19;
  TimeStruct.wSecond:=10;
  TimeStruct.wMilliSeconds:=0;
  if SetSystemTime(TimeStruct) then
    ShowMessage('Yippieh!');
end;
Zum Ermitteln von Sytemdatum und -zeit gibt es entsprechend die Funktion GetSystemTime oder einfacher die Delphi-Funktionen "Date", "Time" und "Now".

Wie kann ich in die aktuelle Zeitzone des Betriebssystems ermitteln?

Dafür gibt es die API-Funktion GetTimeZoneInformation:

procedure TForm1.Button1Click(Sender: TObject);
var T : TIME_ZONE_INFORMATION;
    s : string;
begin
  case GetTimeZoneInformation(T) of
    TIME_ZONE_ID_UNKNOWN  : s:='unbekannt';
    TIME_ZONE_ID_STANDARD : s:=T.StandardName;
    TIME_ZONE_ID_DAYLIGHT : s:=T.DayLightName;
    else       RaiseLastWin32Error;
  end;
  ShowMessage(s);
end; {Marian Maier}

function TForm1.getTZ: integer;
var
  systime : TSystemTime;
begin
  case GetTimeZoneInformation(tz_info) of //Sommerzeit - Winterzeit
    1: result := tz_info.StandardBias + tz_info.Bias;
    2: result := tz_info.DaylightBias + tz_info.Bias;
  else
    result := 0;
  end;
  Listbox1.items.add('Result      : ' + inttostr(GetTimeZoneInformation(tz_info)));
  Listbox1.items.add('Bias:         ' + inttostr(tz_info.Bias));
  Listbox1.Items.add('Standardname: ' + tz_info.StandardName);
  Listbox1.Items.add('Standarddate: ' + inttostr(tz_info.StandardDate.wDay)
    + '.' + inttostr(tz_info.StandardDate.wmonth)
    + '.' + inttostr(tz_info.StandardDate.wyear)
    + ' ' + inttostr(tz_info.StandardDate.whour)
    + ':' + inttostr(tz_info.StandardDate.wminute)
    + ':' + inttostr(tz_info.StandardDate.wsecond)
    + ':' + inttostr(tz_info.StandardDate.wmilliseconds)
    + ' (' + inttostr(tz_info.StandardDate.wdayofweek) + ')');
  Listbox1.items.add('Standardbias: ' + inttostr(tz_info.StandardBias));
  Listbox1.items.add('DayLightName: ' + tz_info.DaylightName);
  Listbox1.Items.add('DayLightDate: ' + inttostr(tz_info.DayLightDate.wDay)
    + '.' + inttostr(tz_info.DayLightDate.wmonth)
    + '.' + inttostr(tz_info.DayLightDate.wyear)
    + ' ' + inttostr(tz_info.DayLightDate.whour)
    + ':' + inttostr(tz_info.DayLightDate.wminute)
    + ':' + inttostr(tz_info.DayLightDate.wsecond)
    + ':' + inttostr(tz_info.DayLightDate.wmilliseconds)
    + ' (' + inttostr(tz_info.DayLightDate.wdayofweek) + ')');
  Listbox1.items.add('DaylightBias: ' + inttostr(tz_info.DaylightBias));
end; {Ralf Imhäuser}

Wie kann man ein Programm in die Windows-Systemsteuerung integrieren?

Weiß jemand, wie man ein Programm/Tool in die Windows-Systemsteuerung integriert ?

Du mußt eine Systemsteuerungs-Datei (Endung .cpl) erzeugen. Im Prinzip handelt es sich hier um eine DLL mit einer speziellen exportierten Funktion (CPLApplet). Seit Delphi 3 ist die Unit CPL.pas als Source vorhanden. Dort finden sich auch einige Hinweise bezüglich Registrierung beim System (ich hoffe, ich verletze mit der Veröffentlichung keine Lizenz- oder Urheberrechte!):

{  General rules for being installed in the Control Panel:

      1) The DLL must export a function named CPlApplet which will handle
         the messages discussed below.
      2) If the applet needs to save information in CONTROL.INI minimize
         clutter by using the application name [MMCPL.appletname].
      2) If the applet is refrenced in CONTROL.INI under [MMCPL] use
         the following form:
              ...
              [MMCPL]
              uniqueName=c:\mydir\myapplet.dll
              ...

  The order applet DLL's are loaded by CONTROL.EXE is:

      1) MAIN.CPL is loaded from the windows system directory.

      2) Installable drivers that are loaded and export the
         CplApplet() routine.

      3) DLL's specified in the [MMCPL] section of CONTROL.INI.

      4) DLL's named *.CPL from windows system directory.


 CONTROL.EXE will answer this message and launch an applet

 WM_CPL_LAUNCH

      wParam      - window handle of calling app
      lParam      - LPTSTR of name of applet to launch

 WM_CPL_LAUNCHED

      wParam      - TRUE/FALSE if applet was launched
      lParam      - NULL

 CONTROL.EXE will post this message to the caller when the applet returns
 (ie., when wParam is a valid window handle)}

Ach ja, Delphi 4 (vielleicht auch 3 ?) kann mit der Compiler-Direktive {$E CPL) dazu angewiesen werden, eine Datei mit der entsprechenden Endung zu erzeugen.

Wie ermittelt man die aktuelle Auflösung und Farbtiefe der Grafikkarte?

Die aktuelle Auflösung der Grafikkarte erhält man, indem man einfach die Dimensionen des TScreen-Objekts abfragt:

Horizontale_Aufloesung:=Screen.Width;
Vertikale_Aufloesung:=Screen.Height;
Zur Ermittlung der Farbtiefe besorgt man sich den DeviceContext des Desktops und ermittelt dessen Farbtiefe:

procedure TForm1.Button1Click(Sender: TObject);
var DesktopDC    : HDC;
    BitsPerPixel : integer;
begin
   DesktopDC := GetDC(0);   // Device-Context des Desktops
   BitsPerPixel := GetDeviceCaps(DesktopDC, BITSPIXEL);
   case BitsPerPixel of
     4: ShowMessage('16 Farben (4-Bit Farbtiefe)');
     8: ShowMessage('256 Farben (8-Bit Farbtiefe)');
    16: ShowMessage('64K Farben (16-Bit Farbtiefe)');
    24: ShowMessage('16M Farben (24-Bit Farbtiefe)');
    32: ShowMessage('True Color (32-Bit Farbtiefe)');
   end;
   ReleaseDC(0, DesktopDC);
end; {frei nach Heino Tiedemann}

Wie ermittelt man die Auflösung eines Druckers?

Um die vertikale und horizontale Auflösung des aktuellen Druckers zu ermitteln, benutzt man die API-Funktion "GetDeviceCaps":

HorzPixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsX);
VertPixelsPerInch := GetDeviceCaps(Printer.Handle, LogPixelsY);

Wie kann man den Monitor in den StandBy-Modus schalten?

Weiß jemand, wie ich in Delphi 3 unter Win98 meinen Monitor in den Standby Modus bringen kann?

Ja, das geht folgendermassen:

//abschalten:
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);

//anschalten:
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);

{Beat Schwarzentrub}
Achtung: Wenn du den Monitor ausschaltest, mußt du ihn auch selber wieder anschalten!

Wie ruft man den Suchen-Dialog des Windows-Explorers auf?

Das funktioniert per DDE-Konversation mit dem Windows-Explorer:

uses DDEMan;

procedure SearchInFolder(Folder:string);
begin
  with TDDEClientConv.Create(Form1) do begin
    ConnectMode := ddeManual;
    ServiceApplication := 'Explorer.exe';
    SetLink('Folders', 'AppProperties');
    OpenLink;
    ExecuteMacro(PChar('[FindFolder(, '+Folder+')]'), true);
    CloseLink;
    Free;
  end;
end; {Markus Goetz}

Eine Liste aller installierten Fonts mit fester Schriftweite erstellen

Mit der API-Funktion EnumFontFamilies kann man eine Liste von Schriftarten erstellen, die alle ein gemeinsames Attribut haben. Das Beispiel von Thorsten Vitt demonstriert, wie man eine Liste von Fonts mit fester oder variabler Schriftweite erstellt, die Namen der Schriftarten werden in ein Memo ausgegeben:

// ----------- Callback.Funktion für Fixed_Pitch -----------------//
function EnumFixedProc(lpelf: PEnumLogFont;
                       lpntm: PNewTextMetric;
                       FontType: Integer;
                       Data: LPARAM)  // hier steht das Strings-Objekt
                       : Integer;     // 0 = Abbrechen
                       stdcall;       // Wichtig bei allen API-Callbacks
begin
  Result := 1;  // nicht abbrechen
  if (lpelf^.elfLogFont.lfPitchAndFamily and FIXED_PITCH) <> 0 then
    (TStrings(Data)).Add(String(lpelf^.elfLogFont.lfFaceName));
end;

// ----------- Callback.Funktion für Variable_Pitch -----------------//
function EnumFixedProc(lpelf: PEnumLogFont;
                       lpntm: PNewTextMetric;
                       FontType: Integer;
                       Data: LPARAM)  // hier steht das Strings-Objekt
                       : Integer;     // 0 = Abbrechen
                       stdcall;       // Wichtig bei allen API-Callbacks
begin
  Result := 1;  // nicht abbrechen
  if (lpelf^.elfLogFont.lfPitchAndFamily and VARIABLE_PITCH) <> 0 then
    (TStrings(Data)).Add(String(lpelf^.elfLogFont.lfFaceName));
end;

// ------------- Button-Handler für Fixed_Pitch ------------------- //
procedure TForm1.bEnumFixedPitchFontsClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
  EnumFontFamilies(Canvas.Handle,  // HDC des Device-Context.
                                   // Printer.Handle für den Drucker.
                   nil,            // Name der Font-Family (PChar)
                   @EnumFixedProc, // Addresse der Callback-Funktion
                   LPARAM(Pointer(Memo1.Lines))); // Benutzerdef. Daten
end;

// ------------- Button-Handler für Variable_Pitch ------------------- //
procedure TForm1.bEnumVariablePitchFontsClick(Sender: TObject);
begin
  Memo1.Lines.Clear;
  EnumFontFamilies(Canvas.Handle,  // HDC des Device-Context.
                                   // Printer.Handle für den Drucker.
                   nil,            // Name der Font-Family (PChar)
                   @EnumVariableProc, // Addresse der Callback-Funktion
                   LPARAM(Pointer(Memo1.Lines))); // Benutzerdef. Daten
end;

Auf Änderungen des Inhalts der Zwischenablage reagieren

Ich suche nach einer Möglichkeit, die Windows-Zwischenablage nur dann auf für mich interessanten Inhalt zu überprüfen, wenn sie modifiziert wurde. Wie kann ich nun auf Änderungen der Zwischenablage reagieren?

Dazu muß man einen "ClipboardViewer" im System registrieren, der dann auf die Windows-Botschaften WM_ChangeCbChain und WM_DrawClipboard reagiert. Dieses Vorgehen demonstriert diese Unit von Gerd Kayser.

Alle Tastatur- oder Mausereignisse abfangen

Ich möchte gerne auch auf Tastatur- oder Mausereignisse, die nicht direkt an mein Programm geschickt wurden, reagieren. Wie kann ich also alle Tastatur- oder Mausnachrichten im System abfangen?

Dazu installiert man mit der Funktion SetWindowsHookEx einen Windows-Hook, den man nach Benutzung UnhookWindowsHookEx mit wieder freigibt. In der c't 5/99 war ein Artikel. der das Komma am Ziffernblock abfängt und den dann in einen Punkt umwandelt. Das ganze war in einer DLL mit zwei Funktionen implementiert, die Heino Tiedemann nach Delphi übersetzt hat.

Im Hauptprogramm muß nun noch z.B. im OnCreate des Hauptformulars die DLL importiert werden und der Hook aktiviert werden, beim Beenden des Programms wird der Hook wieder deaktiviert und die DLL wird aus dem Speicher gekickt:

type
  TMainForm = class(TForm)
  [..]
 private
    { Private-Deklarationen }
    Success: Boolean;
    {Handle der DLL}
    hDLL: HINST; 
    {Handle auf die DLL-Funktion 'DLLInit'}
    InitProc : procedure (hDLL: HINST; install: BOOL); stdcall;
  [..]

procedure TMainForm.FormCreate(Sender: TObject);
begin
  //DLL Einbinden
  hDLL := LoadLibrary('PunktDLL.dll');
  if hDLL = 0 then
  begin
    MessageBox(0,'PunktDLL.dll nicht gefunden',
               'kritischer Fehler',MB_OK or MB_ICONSTOP);
    Success := FALSE;
    //Wird Im OnDestroy abgefragt
    Application.Terminate
  end
  else begin
    Success := TRUE;
    //Funktion aus DLL laden
    InitProc := GetProcAddress(hDLL,'DLLInit');
    //Funktion aus DLL aufrufen; TRUE schaltet den Hook ein
    InitProc(hDLL,TRUE)
  end
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  //DLL Freigeben
  If Success then
    //Funktion aus DLL aufrufen; FALSE schaltet den Hook aus
    InitProc(hDLL,FALSE);
  if hDLL <> 0 then FreeLibrary(hDLL);
end;