function _IsThemeActive: Boolean;
// Returns True if the user uses XP style
const
themelib = 'uxtheme.dll';
type
TIsThemeActive = function: BOOL; stdcall;
var
IsThemeActive: TIsThemeActive;
huxtheme: HINST;
begin
Result := False;
// Check if XP or later Version
if (Win32Platform = VER_PLATFORM_WIN32_NT) and
(((Win32MajorVersion = 5) and (Win32MinorVersion >= 1)) or
(Win32MajorVersion > 5)) then
begin
huxtheme := LoadLibrary(themelib);
if huxtheme <> 0 then
begin
try
IsThemeActive := GetProcAddress(huxtheme, 'IsThemeActive');
Result := IsThemeActive;
finally
if huxtheme > 0 then
FreeLibrary(huxtheme);
end;
end;
end;
end;
// Example Call:
procedure TForm1.Button1Click(Sender: TObject);
begin
if _IsThemeActive then
ShowMessage('Windows Themes are active.');
end;
Showing posts with label detect. Show all posts
Showing posts with label detect. Show all posts
Thursday, March 15, 2007
Tuesday, March 13, 2007
detect memory leaks
procedure TForm.DebugProcessStatus(s: string);
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
MemStat: tMemoryStatus;
begin
MemStat.dwLength := SizeOf(MemStat);
GlobalMemoryStatus(MemStat);
// Get the total and available system memory
TotalMemoryLabel.Caption := 'Total system memory: ' +
FormatFloat('###,###', MemStat.dwTotalPhys / 1024) + ' KByte';
FreeMemoryLabel.Caption := 'Free physical memory: ' +
FormatFloat('###,###', MemStat.dwAvailPhys / 1024) + ' KByte';
// Get the used memory for the current process
cb := SizeOf(TProcessMemoryCounters);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
begin
NewWorkingMemory := Longint(pmc^.WorkingSetSize);
ProcessMemoryLabel.Caption := 'Process-Memory: ' +
FormatFloat('###,###', NewWorkingMemory / 1024) + ' KByte';
MemoryLeakLabel.Caption := 'Memory Loss: ' +
FormatFloat('###,###', (NewWorkingMemory - OldWorkingMemory) / 1024) + ' KByte';
OldWorkingMemory := NewWorkingMemory;
end;
FreeMem(pmc);
DebugStatusLabel.Caption := 'Status: ' + s;
end;
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
MemStat: tMemoryStatus;
begin
MemStat.dwLength := SizeOf(MemStat);
GlobalMemoryStatus(MemStat);
// Get the total and available system memory
TotalMemoryLabel.Caption := 'Total system memory: ' +
FormatFloat('###,###', MemStat.dwTotalPhys / 1024) + ' KByte';
FreeMemoryLabel.Caption := 'Free physical memory: ' +
FormatFloat('###,###', MemStat.dwAvailPhys / 1024) + ' KByte';
// Get the used memory for the current process
cb := SizeOf(TProcessMemoryCounters);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
begin
NewWorkingMemory := Longint(pmc^.WorkingSetSize);
ProcessMemoryLabel.Caption := 'Process-Memory: ' +
FormatFloat('###,###', NewWorkingMemory / 1024) + ' KByte';
MemoryLeakLabel.Caption := 'Memory Loss: ' +
FormatFloat('###,###', (NewWorkingMemory - OldWorkingMemory) / 1024) + ' KByte';
OldWorkingMemory := NewWorkingMemory;
end;
FreeMem(pmc);
DebugStatusLabel.Caption := 'Status: ' + s;
end;
Subscribe to:
Posts (Atom)