Вопрос:
Как увеличить процессорное время, выделяемого программе?
Ответ:
Следующий пример изменяет приоритет приложения. Изменение приоритета следует использовать
с осторожностью - т.к. присвоение слишком высокого приоритета может привети к
медленной работе остальных программ и системы в целом. См. Win32 help for SetThreadPriority()
function.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
ProcessID : DWORD;
ProcessHandle : THandle;
ThreadHandle : THandle;
begin
ProcessID := GetCurrentProcessID;
ProcessHandle := OpenProcess(PROCESS_SET_INFORMATION,
false,
ProcessID);
SetPriorityClass(ProcessHandle, REALTIME_PRIORITY_CLASS);
ThreadHandle := GetCurrentThread;
SetThreadPriority(ThreadHandle, THREAD_PRIORITY_TIME_CRITICAL);
end;
Наверх к содержанию
Вопрос:
Я хочу определить момент окончания изменения размера или перемещения окна. Перехватываю
сообщения WM_SIZE и WM_MOVE но я получаю много таких сообщений а мне нужно узнать
когда именно пользователь закончил перенос или изменение размеров окна. Возможно
ли это?
Ответ:
В следующем примере показан перехват сообщения WM_EXITSIZEMOVE Хотя сообщение
документированно только для Windows NT оно работает точно так же и под Windows
95. Обратите внимание что Вы можите перехватить сообщение WM_ENTERSIZEMOVEдля
определения момента начала пользователем операции изменения размера или перемещения
окна.
Пример:
type
TForm1 = class(TForm)
private
{ Private declarations }
public
procedure WMEXITSIZEMOVE(var Message: TMessage);
message WM_EXITSIZEMOVE;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMEXITSIZEMOVE(var Message: TMessage);
begin
Form1.Caption := 'Finished Moving and sizing';
end;
Наверх к содержанию
Вопрос:
Как определить время последнего доступа к файлу?
Ответ:
См пример. Примечание: не все файловые системы поддерживают время последнего доступа
к файлу.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec : TSearchRec;
Success : integer;
DT : TFileTime;
ST : TSystemTime;
begin
Success := SysUtils.FindFirst('C:\autoexec.bat',
faAnyFile,
SearchRec);
if (Success = 0) and
(( SearchRec.FindData.ftLastAccessTime.dwLowDateTime <> 0)
or ( SearchRec.FindData.ftLastAccessTime.dwHighDateTime <> 0))
then
begin
FileTimeToLocalFileTime(SearchRec.FindData.ftLastAccessTime,DT);
FileTimeToSystemTime(DT,ST);
Memo1.Lines.Clear;
Memo1.Lines.Add('AutoExec.Bat was last accessed at:');
Memo1.Lines.Add('Year := ' + IntToStr(st.wYear));
Memo1.Lines.Add('Month := ' + IntToStr(st.wMonth));
Memo1.Lines.Add('DayOfWeek := ' + IntToStr(st.wDayOfWeek));
Memo1.Lines.Add('Day := ' + IntToStr(st.wDay));
Memo1.Lines.Add('Hour := ' + IntToStr(st.wHour));
Memo1.Lines.Add('Minute := ' + IntToStr(st.wMinute));
Memo1.Lines.Add('Second := ' + IntToStr(st.wSecond));
Memo1.Lines.Add('Milliseconds := ' + IntToStr(st.wMilliseconds));
end;
SysUtils.FindClose(SearchRec);
end;
Наверх к содержанию
Вопрос:
Как использовать функцию Shell API SHBrowseForFolder чтобы позволить пользователю
выбрать каталог?
Ответ:
См. пример
Пример:
uses ShellAPI, ShlObj;
procedure TForm1.Button1Click(Sender: TObject);
var
TitleName : string;
lpItemID : PItemIDList;
BrowseInfo : TBrowseInfo;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
BrowseInfo.hwndOwner := Form1.Handle;
BrowseInfo.pszDisplayName := @DisplayName;
TitleName := 'Please specify a directory';
BrowseInfo.lpszTitle := PChar(TitleName);
BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then begin
SHGetPathFromIDList(lpItemID, TempPath);
ShowMessage(TempPath);
GlobalFreePtr(lpItemID);
end;
end;
Наверх к содержанию
Вопрос:
Как получить дескриптора окна Window, сожержащего DOS программу или программу
консольного режима?
Ответ:
В следуещем примере используется функция Windows API FindWindow(). Обратите внимание,
что WndClass консольного окна отличаются для Windows 95 и Window NT и заголовок
окна может содержать полный путь под Windows NT.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
info : TOSVersionInfo;
ClassName : string;
Title : string;
begin
{Проверяем - Win95 или NT.}
info.dwOSVersionInfoSize := sizeof(info);
GetVersionEx(info);
if (info.dwPlatformId = VER_PLATFORM_WIN32_NT) then begin
ClassName := 'ConsoleWindowClass';
Title := 'Command Prompt';
end else begin
ClassName := 'tty';
Title := 'MS-DOS Prompt';
end;
ShowMessage(IntToStr(FindWindow(PChar(ClassName), PChar(Title))));
end;
Наверх к содержанию
Вопрос:
Возможно ли определить факта изменения системного времени другим приложением?
Ответ:
Следующий прмер перехватывает событие WM_TIMECHANGE. примечание: Приложение ,
изменяющее системное время должно посылать сообщение WM_TIMECHANGE всем окнам.
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMTIMECHANGE(var Message: TWMTIMECHANGE);
message WM_TIMECHANGE;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE);
begin
Form1.Caption := 'Time Changed';
end;
Наверх к содержанию
Вопрос:
Как очистить пункт документы меню кнопки Пуск
Ответ:
Вызовите Windows API функцию SHAddToRecentDocs() передав nil вместо имени файла
в качестве параметра.
Пример:
uses
ShlOBJ;
procedure TForm1.Button1Click(Sender: TObject);
begin
SHAddToRecentDocs(SHARD_PATH, nil);
end;
Наверх к содержанию
Вопрос:
Как опеределить состояние модема под Win32?
Ответ:
См. пример
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStat : DWord;
begin
CommPort := 'COM2';
{Open the comm port}
hCommFile := CreateFile(PChar(CommPort),
GENERIC_READ,
0,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage('Unable to open '+ CommPort);
exit;
end;
{Get the Modem Status}
if GetCommModemStatus(hCommFile, ModemStat) <> false then begin
if ModemStat and MS_CTS_ON <> 0 then
ShowMessage('The CTS (clear-to-send) is on.');
if ModemStat and MS_DSR_ON <> 0 then
ShowMessage('The DSR (data-set-ready) is on.');
if ModemStat and MS_RING_ON <> 0then
ShowMessage('The ring indicator is on.');
if ModemStat and MS_RLSD_ON <> 0 then
ShowMessage('The RLSD (receive-line-signal-detect) is
on.');
end;
{Close the comm port}
CloseHandle(hCommFile);
end;
Наверх к содержанию
Вопрос:
Как добавить пункт к системному меню приложения?
Пример:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMSysCommand(var Msg: TWMSysCommand);
message WM_SYSCOMMAND;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
SC_MyMenuItem = WM_USER + 1;
procedure TForm1.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, '');
AppendMenu(GetSystemMenu(Handle, FALSE),
MF_STRING,
SC_MyMenuItem,
'My Menu Item');
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MyMenuItem then
ShowMessage('Got the message') else
inherited;
end;
Наверх к содержанию
Вопрос:
Как создание нестандартную процедуру разбиения слов при переносах для TEdit, TMemo
или TRichEdit?
Ответ:
В следующем примере создается процедура разбиения слов при переносах для TMemo.
Заметьте, что реализованная процедура просто всегда разрешает перенос. Для дополнительной
информации см.таже документацию к сообщению EM_SETWORDBREAKPROC.
var
OriginalWordBreakProc : pointer;
NewWordBreakProc : pointer;
function MyWordBreakProc(LPTSTR : pchar;
ichCurrent : integer;
cch : integer;
code : integer) : integer
{$IFDEF WIN32} stdcall; {$ELSE} ; export; {$ENDIF}
begin
result := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OriginalWordBreakProc := Pointer(
SendMessage(Memo1.Handle,
EM_GETWORDBREAKPROC,
0,
0));
{$IFDEF WIN32}
NewWordBreakProc := @MyWordBreakProc;
{$ELSE}
NewWordBreakProc := MakeProcInstance(@MyWordBreakProc,
hInstance);
{$ENDIF}
SendMessage(Memo1.Handle,
EM_SETWORDBREAKPROC,
0,
longint(NewWordBreakProc));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(Memo1.Handle,
EM_SETWORDBREAKPROC,
0,
longint(@OriginalWordBreakProc));
{$IFNDEF WIN32}
FreeProcInstance(NewWordBreakProc);
{$ENDIF}
end;
Наверх к содержанию
Вопрос:
Можно ли скопировать группу файлов, используя стандартный диалог с анимацией Копирование
Файлов, который использует "Проводник" (Explorer)?
Ответ:
В следующем примере используется функция SHFileOperation для копирования группы
файлов и показа анимированного диалога. Вы можете использовать также следующие
флаги для копирования, удаления, переноса и переименования файлов.
TO_COPY
FO_DELETE
FO_MOVE
FO_RENAME
Примечание: буфер, содержащий имена файлов для копирования должен заканчиваться
двумя нулевыми символами.
Пример:
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
Fo : TSHFileOpStruct;
buffer : array[0..4096] of char;
p : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
p := StrECopy(p, 'C:\DownLoad\1.ZIP') + 1;
p := StrECopy(p, 'C:\DownLoad\2.ZIP') + 1;
p := StrECopy(p, 'C:\DownLoad\3.ZIP') + 1;
StrECopy(p, 'C:\DownLoad\4.ZIP');
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd := Handle;
Fo.wFunc := FO_COPY;
Fo.pFrom := @Buffer;
Fo.pTo := 'D:\';
Fo.fFlags := 0;
if ((SHFileOperation(Fo) <> 0) or
(Fo.fAnyOperationsAborted <> false)) then
ShowMessage('Cancelled')
end;
Наверх к содержанию
Вопрос:
Как узнать серийный номер диска
Ответ:
procedure TForm1.Button1Click(Sender: TObject);
var
VolumeName,
FileSystemName : array [0..MAX_PATH-1] of Char;
VolumeSerialNo : DWord;
MaxComponentLength,
FileSystemFlags : Integer;
begin
GetVolumeInformation('C:\',VolumeName,MAX_PATH,@VolumeSerialNo,
MaxComponentLength,FileSystemFlags,
FileSystemName,MAX_PATH);
Memo1.Lines.Add('VName = '+VolumeName);
Memo1.Lines.Add('SerialNo = $'+IntToHex(VolumeSerialNo,8));
Memo1.Lines.Add('CompLen = '+IntToStr(MaxComponentLength));
Memo1.Lines.Add('Flags = $'+IntToHex(FileSystemFlags,4));
Memo1.Lines.Add('FSName = '+FileSystemName);
end;
Наверх к содержанию
Вопрос:
Как узнать является диск CD-диском,сетевым диском, виртуальным диском или сьемным
диском?
Ответ:
Windows API функция GetDriveType().
Пример:
procedure TForm1.Button1Click(Sender: TObject);
begin
case GetDriveType('C:\') of
0 : ShowMessage('The drive type cannot be determined');
1 : ShowMessage('The root directory does not exist');
DRIVE_REMOVABLE:ShowMessage('The disk can be removed');
DRIVE_FIXED : ShowMessage('The disk cannot be removed');
DRIVE_REMOTE : ShowMessage('The drive is remote (network) drive');
DRIVE_CDROM : ShowMessage('The drive is a CD-ROM drive');
DRIVE_RAMDISK : ShowMessage('The drive is a RAM disk');
end;
end;
Наверх к содержанию
Вопрос:
Как проверить готовность диска без появления окна ошибки Windows?
Ответ:
Вы можете использовать функцию Windows API SetErrorMode() для отключения диалога
Window's critical Error.
Пример:
function IsDriveReady(DriveLetter : char) : bool;
var
OldErrorMode : Word;
OldDirectory : string;
begin
OldErrorMode := SetErrorMode(SEM_NOOPENFILEERRORBOX);
GetDir(0, OldDirectory);
{$I-}
ChDir(DriveLetter + ':\');
{$I+}
if IoResult <> 0 then
Result := False
else
Result := True;
ChDir(OldDirectory);
SetErrorMode(OldErrorMode);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not IsDriveReady('A') then
ShowMessage('Drive Not Ready') else
ShowMessage('Drive is Ready');
end;
Наверх к содержанию
Вопрос:
Использование FindFirst для поиска файлов.
Ответ:
begin
Result := SysUtils.FindFirst(Path, Attr, SearchRec);
while Result = 0 do
begin
ProcessSearchRec(SearchRec);
Result := SysUtils.FindNext(SearchRec);
end;
SysUtils.FindClose(SearchRec);
end;
Наверх к содержанию
Вопрос:
Как получить дескриптор окна другого приложения и сделать его активным?
Ответ:
Использование фуекции Windows API FindWindow() - простейший способ нахождение
окна, при условии, что известен его заголовок или имя оконного класса. Если Вам
известна только часть заголовка окна (например 'Netscape - ' + 'какой-то неизвестный
URL'), Вам нужно использовать функцию EnumWindows() для получения всех окон, затем
вызывать функцию GetWindowsText() и GetClassName для поиска нужного окна. Следующий
пример находит первое окно, содержащее совпадающую часть заголовка окна и полностью
совпадающее название оконного класса (если он задан) и делает это окно активным.
type
PFindWindowStruct = ^TFindWindowStruct;
TFindWindowStruct = record
Caption : string;
ClassName : string;
WindowHandle : THandle;
end;
function EnumWindowsProc(hWindow : hWnd;
lParam : LongInt) : Bool
{$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
var
lpBuffer : PChar;
WindowCaptionFound : bool;
ClassNameFound : bool;
begin
GetMem(lpBuffer, 255);
Result := True;
WindowCaptionFound := False;
ClassNameFound := False;
try
if GetWindowText(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0
then WindowCaptionFound := true;
if PFindWindowStruct(lParam).ClassName = '' then
ClassNameFound := True else
if GetClassName(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer))
> 0 then ClassNameFound := True;
if (WindowCaptionFound and ClassNameFound) then begin
PFindWindowStruct(lParam).WindowHandle := hWindow;
Result := False;
end;
finally
FreeMem(lpBuffer, sizeof(lpBuffer^));
end;
end;
function FindAWindow(Caption : string;
ClassName : string) : THandle;
var
WindowInfo : TFindWindowStruct;
begin
with WindowInfo do begin
Caption := Caption;
ClassName := ClassName;
WindowHandle := 0;
EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
FindAWindow := WindowHandle;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TheWindowHandle : THandle;
begin
TheWindowHandle := FindAWindow('Netscape - ', '');
if TheWindowHandle = 0 then
ShowMessage('Window Not Found!') else
BringWindowToTop(TheWindowHandle);
end;
Наверх к содержанию
Вопрос:
Как написать программу не имеющую ни одной формы?
Ответ:
Создайте новое приложение, затем удалите из проекта все unitы - (Delphi 3 - View
- Project Manager)
(Delphi 4 - Project - Remove from project)
Откройте файл проекта
(Delphi 3 - View - Project Source)
(Delphi 3 - Project - View Source)
и отредактируйте его так как приведино ниже.
Пример:
program Project1;
{$R *.RES}
uses SysUtils;
var
f : TextFile;
begin
AssignFile(f, 'TestFile.Txt');
ReWrite(f);
Writeln(f, 'Test');
Close(f);
end.
Наверх к содержанию
Вопрос:
Почему возникает ошибка при передаче параметров типа boolean равного True в некоторые
внешней функции
Ответ:
В Delphi 3 значение "True" для типов ByteBool, WordBool LongBool представляется
как -1 для совместимости с Microsoft Visual Basic. Многие компиляторы представляют
"True" как либо "не нуль" либо 1. При передаче параметров в не Visual Basic-приложения
Вам следует придерживаться следующей техники во избежание несовместимости:
LongBool(Abs(True));
При приеме значений типа boolean из внешних программ Вам следует всегда проверять
его на значение "False". Эта техника всегда работает, поскольку "False" всегда
представляется нулем.
if BoolValPassed <> False then DoSomething.
Наверх к содержанию
Вопрос:
Как получить длинное имя файла или каталога, зная короткое имя?
Ответ:
Используйте Win32_Find_Data поле TSearchRec.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec : TSearchRec;
Success : integer;
begin
Success := SysUtils.FindFirst('C:\DownLoad\dial-u~1.htm',
faAnyFile,
SearchRec);
if Success = 0 then begin
ShowMessage(SearchRec.FindData.CFileName);
end;
SysUtils.FindClose(SearchRec);
end;
Наверх к содержанию
Вопрос:
Как временно отключить range checking для участка программы, а затем вновь вклчить
его?
Ответ:
Можно сделать это, используя "IFOPT" и "DEFINE".
type
PSomeArray = ^TSomeArray;
TSomeArray = array[0..0] of integer;
procedure TForm1.Button1Click(Sender: TObject);
var
p : PSomeArray;
i : integer;
begin
{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}
GetMem(p, sizeof(integer) * 200);
try
for i := 1 to 200 do
p[i] := i;
finally
FreeMem(p, sizeof(integer) * 200);
end;
{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}
end;
Наверх к содержанию
Вопрос:
Как получить имя файла и путь локальной таблицы?
Ответ:
Следующий пример взят из файла BDE32.HLP Borland/CommonFiles/BDE directory:
implementation
{$R *.DFM}
uses DbiTypes, DbiProcs;
function fDbiFormFullName(Tbl: TTable): String;
var
Props: CurProps;
Buffer1 : array[0..DBIMAXPATHLEN] of char;
Buffer2 : array[0..DBIMAXPATHLEN] of char;
begin
Check(DbiGetCursorProps(Tbl.Handle,Props));
StrPCopy(Buffer1, Tbl.TableName);
Check(DbiFormFullName(Tbl.DBHandle,
@Buffer1,
Props.szTableType,
@Buffer2));
Result := StrPas(Buffer2);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Add(fDbiFormFullName(Table1));
end;
Примечание:
Таблица должна быть открытой.
Работает с локальными таблицами.
Наверх к содержанию
Вопрос:
Как получить дескриптор панели задач (TaskBar)?
Ответ:
hTaskbar := FindWindow('Shell_TrayWnd', Nil );
Наверх к содержанию
Вопрос:
Как из программы запустить Screen Saver?
Ответ:
Представленная ниже функция демонстрирует как это сделать
function TurnScreenSaverOn : bool;
var
b : bool;
begin
result := false;
if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE,
0,
@b,
0) <> true then exit;
if not b then exit;
PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
result := true;
end;
Наверх к содержанию
Вопрос:
Как выяснить установлены ли в системе шрифты TrueType?
Ответ:
function IsTrueTypeAvailable : bool;
var
{$IFDEF WIN32}
rs : TRasterizerStatus;
{$ELSE}
rs : TRasterizer_Status;
{$ENDIF}
begin
result := false;
if not GetRasterizerCaps(rs, sizeof(rs)) then exit;
if rs.WFlags and TT_AVAILABLE <> TT_AVAILABLE then exit;
if rs.WFlags and TT_ENABLED <> TT_ENABLED then exit;
result := true;
end;
Наверх к содержанию
Вопрос:
Как переслать файл в Мусорную Корзину?
Ответ:
Используйте функцию SHFileOperation().
uses ShellAPI;
procedure SendToRecycleBin(FileName: string);
var
SHF: TSHFileOpStruct;
begin
with SHF do begin
Wnd := Application.Handle;
wFunc := FO_DELETE;
pFrom := PChar(FileName);
fFlags := FOF_SILENT or FOF_ALLOWUNDO;
end;
SHFileOperation(SHF);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendToRecycleBin('c:\DownLoad\Test.gif');
end;
Наверх к содержанию
Вопрос:
Как изменить обои Windows програмно?
Ответ:
Изменить обои можно функцией SystemParametersInfo()Б переслав ей в качестве параметров
константу SPI_SETDESKWALLPAPER и имя нового файла обоев.
Пример:
SystemParametersInfo(SPI_SETDESKWALLPAPER,
0,
PChar('C:\SOMEPATH\SOME.BMP'),
SPIF_SENDWININICHANGE);
Наверх к содержанию
Вопрос:
Как выяснить запущен ли Delphi / C++ Builder?
Ответ:
Используйте функцию FindWindow. (Класс главного окна Delphi / C++ Builder - TAppBuilder)
if FindWindow('TAppBuilder', Nil) <> 0 Then
ShowMessage('Delphi and or C++ Builder is running');
Наверх к содержанию
Вопрос:
Как програмно выяснить версию Windows?
Ответ:
{$IFDEF WIN32}
function GetVersionEx(lpOs : pointer) : BOOL; stdcall;
external 'kernel32' name 'GetVersionExA';
{$ENDIF}
procedure GetWindowsVersion(var Major : integer;
var Minor : integer);
var
{$IFDEF WIN32}
lpOS, lpOS2 : POsVersionInfo;
{$ELSE}
l : longint;
{$ENDIF}
begin
{$IFDEF WIN32}
GetMem(lpOS, SizeOf(TOsVersionInfo));
lpOs^.dwOSVersionInfoSize := SizeOf(TOsVersionInfo);
while getVersionEx(lpOS) = false do begin
GetMem(lpos2, lpos^.dwOSVersionInfoSize + 1);
lpOs2^.dwOSVersionInfoSize := lpOs^.dwOSVersionInfoSize + 1;
FreeMem(lpOs, lpOs^.dwOSVersionInfoSize);
lpOS := lpOs2;
end;
Major := lpOs^.dwMajorVersion;
Minor := lpOs^.dwMinorVersion;
FreeMem(lpOs, lpOs^.dwOSVersionInfoSize);
{$ELSE}
l := GetVersion;
Major := LoByte(LoWord(l));
Minor := HiByte(LoWord(l));
{$ENDIF}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Major : integer;
Minor : integer;
begin
GetWindowsVersion(Major, Minor);
Memo1.Lines.Add(IntToStr(Major));
Memo1.Lines.Add(IntToStr(Minor));
end;
Наверх к содержанию
Вопрос:
Как узнать переменные окружения (environment variable) DOS, например path?
Ответ:
Windows API - функция
GetDOSEnvironment() для Win16 и
GetEnvironmentStrings() для Win32.
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
p : pChar;
begin
Memo1.Lines.Clear;
Memo1.WordWrap := false;
{$IFDEF WIN32}
p := GetEnvironmentStrings;
{$ELSE}
p := GetDOSEnvironment;
{$ENDIF}
while p^ <> #0 do begin
Memo1.Lines.Add(StrPas(p));
inc(p, lStrLen(p) + 1);
end;
{$IFDEF WIN32}
FreeEnvironmentStrings(p);
{$ENDIF}
end;
Наверх к содержанию
Вопрос:
Как рисовать непосредственно на Рабочем столе?
Ответ:
Пример:
procedure TForm1.Button1Click(Sender: TObject);
var
dc : hdc;
begin
dc := GetDc(0);
MoveToEx(Dc, 0, 0, nil);
LineTo(Dc, 300, 300);
ReleaseDc(0, Dc);
end;
Наверх к содержанию