Ermitteln der MauskoordinatenSystem
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;
|
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;
|
Wie ermittle ich verschiedene Systemparameter, wie Systemordner, Usernamen, etc.?
Die WinFuncs enthält verschiedene Funktionen zur Ermittlung folgender Systemparameter:
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;
|
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; |
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}
|
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;
|