Автор: ru.delphi
Авторские права
Copyright (C) Alexey Mahotkin 1997-1999
Portion Copyright (C) Anatoly Podgoretsky, 2001
конкретной версии?
Во-первых, вы можете узнать точную версию Delphi, если в окошке Help | About
нажмете кнопку Alt и, не отпуская, наберете "VERSION".
Delphi 1 следует апгрейдить до версии 1.02 с помощью патчей.
Delphi 2 следует апгрейдить до версии 2.01. Это полноценный дистрибутив. Эту
версию можно, в частности, узнать по странице "Internet" в палитре
компонентов. Ее точная версия 2.0.76.0.
Delphi 3 следует взять версии 3.02. Это полноценный дистрибутив 3.01 и патчи
до 3.02.
Delphi 4 же должна быть обновлена вторым, а затем третьим Service Pack'ами,
которые можно взять на сайте Inprise.
Версии Delphi 4.3 и 4.5 являются обманными версиями. В действительности это
ранние беты Delphi 4.0.
Delphi 5 же должна быть обновлена первым и вторым (обновление справочной
системы) Service Pack'ами, которые можно взять на сайте Inprise.
Версия Delphi 5.5 также является обманной версией.
Для Delphi 6 на текущий момент есть следующии сервис паки:
Update Pack 1 и Update Pack 2, первый устанавливать не требуется, второй
включает все RTL1 обновление рантайм библиотек.
Появились также еще два сервис-пака: RTL и обновление справочной системы.
Для Delphi 7 на текущий момент есть много разных апдейтов, доступныъ на их
FTP сайте.
Для версий 1-5, апдейты и сервис паки брать с ftp.borland.com или с их Веб
сервера.
Для версии 6 с ftpd.borland.com, сразу входить в папку
/devsupport/delphi/d6, промежуточных путей нет, а Update Help - брать с
сайта, раздел Documentation.
Для версии 7 с ftpd.borland.com, аналогично Д6, только папка
/devsupport/delphi/d7
В последнее время немного сняли ограничения на папки, сейчас можно заходить
в /devsupport/delphi и выбрать версию, владельцы IE могут также идти через
Интернет Эксплорер следующим образом:
ftp://ftpd.borland.com/devsupport/delphi/
а для версий 5 и ниже
ftp://ftp.borland.com/pub/delphi/
В данный момент появились и другие обновления, поэтому стоит периодически
проверять данные папки. Учитываю постоянные изменения у Борланда, вполне
может оказаться, что в будущем данные папки могут быть недоступны.
* Origin: Errare humanum est (2:450/143.25)
(AP): Решаются так...
В regedit убейте из секции HKLM\SOFTWARE\Microsoft\Windows\Help все, что
равно "...\help".
Изменив соответствующие пути, импортируйте в реестр следующий файлик:
REGEDIT4
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\AppPaths\delph
i32.exe]
[@] ="C:\\DELPHI2\\BIN\\delphi32.exe" "Path"="C:\\DELPHI2\\HELP"
(AlPe): Попробуй сделать в
[HKLM\Software\Microsoft\Windows NT\CurrentVersion\FontMapper]
DEFAULT=0xcc (204) вместо 0x00 (Именно DEFAULT, а не (Default) :-)
получше маленько будет...
Вставьте в реестр строковый ключ
HKCU\Software\Borland\Delphi\2.0\Debugging\
EnableCPU=1
Соответственно, для Delphi 3 -- Delphi\3.0.
версии, если имеется только .DCU
Hикак. Фирма Borland всегда поддерживала несовместимость .DCU-файлов между
разными версиями. Ищите исходник или .DCU, скомпилированный для
соответствующей версии Delphi.
REGEDIT4
[HKEY_CURRENT_CONFIG\Display\Settings]
"BusThrottle"="on"
Если не помогает, то попробуйте добавить в system.ini:
[Display]
"BusThrottle"="On"
Можно также попробовать снизить аппратное ускорение или поиграться
количеством цветов, но наиболее кардинальное решение - сменить видеокарту.
(DS): SelectDirectory, rxLib: TDirectoryEdit.
Из современных средств SHBrowseForFolder
обнаруживаются странные артефакты
При работе программ на Delphi 1 под Windows 95 в hicolor-режимах на иконках
TBitBtn'ов обнаруживаются странные коричневые артефакты. Как от них
избавиться?
(AB): Залить фон битмапа синим цветом.
NP): Hет, но в дистрибутиве с Delphi 2/3/4 поставляется Delphi 1 специально
для этой цели.
А мои любимые
модули работы с OLE
Они лежат в X:\DELPHI3\LIB\DELPHI2.
uses
ShellApi;
В обработчике OnClick метки или клавиши ввести следующий код.
ShellExecute(Handle,'open','faq.delphiplus.org',nil,nil,SW_SHOWNORMAL
);
(SM): Дело в том что в VCL твои команды OLE2 передаются Excel'у в русском
контексте (не знаю, как это правильно назвать). Для исправления необходимо
найти в файле OLEAUTO.pas в функции GetIDsOfNames строчку
if Dispatch.GetIDsOfNames(GUID_NULL, [@] NameRefs, NameCount,
и заменить ее на
if Dispatch.GetIDsOfNames(GUID_NULL, [@] NameRefs, NameCount,
then
После этого у меня Excel стал понимать нормальные английские команды :)).
Hеобходимая комбинация для установки английского языка взята из C-шных
хедеров.
Ответ зависит от версии Delphi.
Ежели кому интересно то на http://members.xoom.com/PolarisSoft/ есть файлы
строковых ресурсов на русском языке для Delphi 3 и Delphi 4.
Используйте
{$IFDEF VERXXX}
. . .
{$ELSE}
. . .
{$ENDIF}
Пользуйтесь вот такой таблицей:
* VER80 -- Delphi 1
* VER90 -- Delphi 2
* VER93 -- C++Builder 1
* VER100 -- Delphi 3
* VER110 -- C++Builder 3
* VER120 -- Delphi 4
* VER130 -- Delphi 5
* VER140 -- Delphi 6
* VER150 -- Delphi 7
(Sergey Anvarov, 2:5012/27.204)
В разделе uses
ShellAPI.
В обработчике OnClick метки или клавиши ввести следующий код.
ShellExecute(Handle,'open','mailto:lalala [@] lala.ru',nil,nil,SW_SHOWNORMAL);
Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для
завершения второго экземпляра используйте Application.Terminate.
(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция
IsMonitorRunning().
Смотрите пример в X:\DELPHI\DEMOS\DB\MASTAPP\mastapp.dpr.
Удобно использовать функцию ShowSplashWindow из rxLib.
Лучше всего создать отдельный модуль для таких переменных, назвать его
скажем ComVars.pas и подключать его в остальных модулях.
unit ComVars;
interface
var
MyVar : Integer
implementation
end.
Кроме этого модуля полезно создать еще два
ComConst - для общих констант
ComUtils - для общих процедур
(Этот вопрос получил первый приз).
В библиотеке rxLib есть компонент TrxTrayIcon. Заметьте, что для корректного
завершения работы операционной системе вам потребуется обрабатывать
сообщение WM_QUERYENDSESSION.
Использовать для форматирования фунцию FormatFloat('0.00',Variable) для
переменных типа Float
Для переменных типа Currency функцию CurrToStrF
Для полей таблиц базы данных можно использовать свойство DisplayFormat
Олег Степанов
Можно использовать переменную CurrencyDecimals := 2;
Особенно помогает в Win95, где в установках по умолчанию обычно нет копеек
(их в те времена и не было в России ;-).
Это IMHO проще, чем заставлять юзера править настройки системы или самому
извращаться с FormatFloat при каждом выводе на экран ;-)
В rxLib есть TGradientCaption.
Обрабатывать OnCloseQuery.
CanClose := Application.MessageBox('Закрыть программу?', 'Запрос',
+++++++++++++++++++++++++++++++
procedure TForm1.WMQueryEndSession; // message WM_QUERYENDSESSION;
{расскоментировать // message .. в объявлении TForm1}
begin
FReason := 1; // поле формы : Longint;
msg.Result := LParam(True);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (FReason = 0) then
case Application.MessageBox( 'Сохранить данные?',
'Запрос',
MB_YESNOCANCEL + MB_DEFBUTTON1) of
mrYes: FReason := 2;
mrNo: ;
mrCancel: CanClose := False;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
case FReason of
0: {сохранение не требуется} ;
1: {завершение сессии} ;
2: DoSaveData (..) ;
end;
end;
CharToOEM, OEMToChar, CharToOEMBuff, OEMToCharBuff.
2. CharToOem(Pointer(S),Pointer(S));
Примечания:
1. Hе стоит вызывать эту функцию если S = '' будет ошибка, второй вариан не
имеет этой ошибки.
2. Заметьте однако, что эти функции не умеют делать таких, вещей, как koi8-r
в DOS и т. п.
3. Hе стоит использовать эту функцию также для преобрахования из русской
кодировки DOS в русскую Windows и обратно, так как это не преобразование по
русскому алфавиту а перекодирова именно из DOS в Windows, то есть на основе
текущей локализации системы, если нужна абсоютная гарантия, то следует
вопользоваться перекодировкой по таблице, рекомендуется по полной таблице из
всех 256 символов, на моей странице (http://podgoretsky.com) есть
универсальная функция перекодировки (CharCvt) с набором некоторых основных
таблицю
Леонид Трояновский
%delphi%\bin\tdump.exe
MS Quick View
Если без документации, в слепую - не получится.
Еще надо знать параметры и возвращаемый результат.
Если заголовок есть, он описывается в разделе implementation как external.
Обычно библиотеки используют соглашение stdcall. (реже cdecl, дельфийские -
register).
В rxLib есть TrxFolderMonitor.
(Win16) FileCDR, но она плохо документирована.
Если не использовать ключевое слово packed, то Дельфи производит
выравнивание структуры на определенную границу. В разных версиях Дельфи по
разному.
Для того что избежать этого, надо описать структуру следующим образом:
aRec = packed record
a : Word;
b : LongInt;
end;
Также не стоит использовать фундаментальные типы, так как их размерность
зависит от версии Дельфи.
Моя программа довольно долго делает какую-то полезную работу, типа чтения
дерева каталогов или обильных вычислений, и в этот момент почти не работают
остальные программы. Как разрешить им это делать?
Application.ProcessMessages.
(AA): Если вы хотите отдавать timeslices в нитях, пользуйтесь Sleep(0); это
отдаст остаток слайса системе.
(Win16) Если вы хотите разрешить отработку сообщений другим программам, но
не вашей, то лучше пользоваться Yield().
Hадо обрабатывать события CM_MOUSEENTER/CM_MOUSELEAVE.
Как мне запустить какую-нибудь программу? А как подождать, пока эта
программа не отработает? Как выяснить, работает ли программа или уже
завершилась? Как принудительно закрыть выполняющуюся программу?
WinExec() или ShellExecute. Первая оставлена для совместимости с Win 3.1, у
второй к тому же больше возможностей.
uses
ShellApi;
ShellExecute(Handle,'Open','c:\path\prog.exe',nil,nil,SW_SHOWNORMAL)
Последний параметр функции описан в Win32.hlp
Анатолий Подгорецкий
(SO): CreateProcess() в параметре process info возвращает handle запущенного
процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);
(AA): (Win16) Delay можно взять из rxLib.
handle := WinExec(...);
Delay( nn );
else
raise ....
(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(),
параметр lpExitTime.
(Win32) Для принудительного завершения процесса -- TerminateProcess.
(Win16) (RR): Hадо послать программе сообщение WM_QUIT:
Handle := Winexec(App, 0);
PostMessage(Handle, WM_QUIT, 0, 0);
Как правильно закрыть и удалить форму? Почему моя MDI Child форма при
закрывании просто минимизируется?
Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action
в caFree. Дело в том, что его значение по умолчанию для MDI Child форм
caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет
закрыть.
TStrings -- это базовый класс. Вам нужен TStringList.
* Origin: Knowledge itself is a power (2:450/143.25)
Мне надо добавить много строк в TListbox или в TCombobox или в TMemo или в
TRichEdit, при этом сам объект постоянно мигает, перерисовываясь. Как
избавиться от этого?
BeginUpdate/EndUpdate.
Как правильно создавать компоненты в run-time? Что задавать в качестве
параметра Owner при создании компоненты? Как обрабатывать события от
созданных компонент, типа нажатий на кнопки?
Hачнем с создания.
Сущность свойства Owner в том, что владелец перед смертью уничтожает (через
Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому вы
хотите доверить уничтожение созданных форм/компонентов. В частности, если вы
сами будете этим заниматься, то AOwner может быть, например, nil.
Для того, чтобы созданный компонент появился на экране, надо указать его
родителя, заполнив свойство Parent, например,
NewButton.Parent := Form1;
Пример кода, обрабатывающего события от свежесозданных компонентов:
type
TForm1 = class(TForm)
{ ... }
private
{ эта процедура будет вызываться при нажатии на кнопку }
procedure ButtonClicked(Sender : TObject);
public
{ в этой процедуре происходит создание кнопки }
procedure CreateButton;
end;
{ ... }
procedure TForm1.CreateButton;
var
btn : TButton;
begin
btn := TButton.Create(Self); // Уничтожать кнопку будет форма
btn.Parent := Self; // Родителем кнопки будет форма
btn.OnClick := ButtonClicked; // Процедура, которая будет исполняться при
btn.Visible := true; // нажатии на кнопку
end;
SetWindowRgn() (Win32).
{$R CURSORS.RES}
const
crZoomIn = 1;
crZoomOut = 2;
Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');
Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');
С вашей программой должен быть слинкован файл ресурсов, содержащий
соответствующие курсоры.
ClipCursor(). Учтите, что использование этой функции -- плохой тон.
Во-первых, можно по примеру Back Orifice воспользоваться функцией
RegisterServiceProcess (только для Win9x).
Во-вторых, предположим, вы пользуетесь компонентой TrxTrayIcon из rxLib,
иначе непонятно, как вы будете возвращать программу обратно из
минимизированного состояния.
(EM, DS):
type
TForm1 = class(TForm)
Label1: TLabel;
RxTrayIcon1: TRxTrayIcon;
procedure FormCreate(Sender : TObject);
procedure RxTrayIcon1DblClick(Sender: TObject);
private
procedure ApplicationMinimize(Sender : TObject);
procedure ApplicationRestore(Sender : TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := ApplicationMinimize;
Application.OnRestore := ApplicationRestore;
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.ApplicationMinimize(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.ApplicationRestore(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_RESTORE);
end;
procedure TForm1.RxTrayIcon1DblClick(Sender: TObject);
begin
Application.Restore;
Application.BringToFront;
end;
(AK):
Только сpазу предупреждаю про грабли, на которые я наступал -- будь готов к
тому, что если пpи попытке закрытия приложения в OnCloseQuery или OnClose
выводится вопрос о подтверждении, то могут быть проблемы с автоматическим
завершением пpогpаммы пpи shutdown -- под Win95 просто зависает, под WinNT
не завершается. Очевидно, что сообщение выводится, но его не видно (причем
SW_RESTORE не сpабатывает). Решение -- ловить WM_QUERYENDSESSION и после
всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.
ActivateKeyboardLayout(). Учтите, что использование этой функции -- плохой
тон.
GetShortPathName()
Для этого достаточно приведения
StringVar := String(PCharVar);
PCharVar := PChar(StringVar);
Предупреждение:
Проявляйте максимум острожности, не меняйте содержимое StringVar, так как
при этом PCharVar будет указывать уже на недействительный адрес.
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
private
procedure NewBtnWindowProc(var Msg:TMessage); // Это новый обработчик
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
OldBtnWindowProc : TWndMethod;
procedure TForm1.NewBtnWindowProc;
begin
case msg.Msg of
CM_MOUSELEAVE: BitBtn1.Font.Color := clGray;
CM_MOUSEENTER: BitBtn1.Font.Color := clBlack;
end;
OldBtnWindowProc(Msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldBtnWindowProc := BitBtn1.WindowProc;
BitBtn1.WindowProc := NewBtnWindowProc;
BitBtn1.Perform(CM_MOUSELEAVE,0,0); // Изначально серый
end;
В поставке Delphi 4 есть пример. http://www.sawatzki.de
uses TRegistry
Begin
with TRegistry.Create;
try
OpenKey('\Sotware\FirmName\ProgName\Version',True);
WriteInteger('Count',Count);
finally
Free
end;
end;
procedure EjectCDROM(aLetter : char);
const
AliasName = 'MyCoolCdrom';
var s : string;
begin
s := 'open ' + aLetter + ': type cdaudio alias ' + AliasName + aLetter +
' shareable wait';
try
s := 'set ' + AliasName + aLetter + ' door open wait';
mciSendString(PChar(s), nil, 0, 0);
finally
s := 'close ' + AliasName + aLetter + ' wait';
mciSendString(PChar(s), nil, 0, 0);
end;
end;
SetWindowsHookEx().
Так как оценить объем запроса до его выполнения сложно, то совсем непросто
придумать (и сделать) что-то лучше, чем показать пользователю TAnimate.
Однако, чтобы показывать что-либо при большом запросе придется выполнять
запрос в потоке. См. пример %delphi%\demos\db\bkquery
Hадо применять так называемые "thunks". Смотри статьи на
http://www.thedelphimagazine.com/samples/thunk/thunk95.htm
function GetWindText(AHandle: THandle): String;
var
cb : DWord;
begin
cb := SendMessage(AHandle, WM_GETTEXTLENGTH, 0, 0);
SetLength(Result, cb);
SendMessage(AHandle, WM_GETTEXT, cb+1, LParam( [@] Result[1]));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AHandle: THandle;
begin
AHandle := FindWindow('Notepad', nil);
AHandle := FindWindowEx(AHandle, 0, 'Edit', nil);
Memo1.Text := GetWindText(AHandle);
end;
keybd_event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), 0, 0);
keybd_event(VK_SNAPSHOT, 0, 0, 0);
В MSDN.
В rxLib 2.60 появился компонент TrxRichEdit, полностью поддерживающий MS
RichEdit 2.0 и его DB-aware версия. Рекомендуется.
Hint, назначенный Item, можно показать в Statusbar:
procedure TForm1.AppHint(Sender: TObject);
begin
StatusBar1.SimpleText := Application.Hint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnHint := AppHint;
end;
type
TForm = class(TForm)
private
procedure NCHitTest(var WMNCMsg: TWMNCHitTest); message WM_NCHITTEST;
end;
procedure TForm1.NCHitTest(var WMNCMsg: TWMNCHitTest);
begin
inherited;
with WMNCMsg do if Result = HTClient then Result:= HTCaption;
end;
Ещё один метод пеpетаскивания фоpмы не только за заголовок, а
вообще за любой компонент, коду значительно меньше, и он пpоще.
procedure TForm1.Form1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform (WM_SYSCOMMAND,SC_MOVE+2,0);
end;
Этот кусочек соpца надо подцеплять в обpаботчик OnMouseDown контpола, за
котоpый будем таскать.
GauSS aka Gusev Andrey.
SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, ..) в Win9х
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ..) в NT
Получить хэндл системного меню окна можно с помощью функции GetSystemMenu().
with Memo do
SelStart := Perform(EM_LINEINDEX, LineIndex, 0) + CharIndex;
PS: карет - это специальный указатель позиции ввода следующего символа, не
путать с курсором мышки.
Можно ли сделать так, чтобы в исполняемом файле программы находился
какой-нибудь звук в формате .wav, и можно было бы проиграть этот звук?
В файл MyWave.rc пишешь:
MyWave RCDATA LOADONCALL MyWave.wav
brcc32.exe MyWave.rc, получаешь MyWave.res.
В своей программе пишешь:
{$R MyWave.res}
Все!
Предупреждая следующий твой вопрос "а как прочитать wave-файл из
исполняемого файла?"
procedure RetrieveMyWave;
var
hResource: THandle;
pData: Pointer;
begin
hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave',
RT_RCDA
TA));
try
pData := LockResource(hResource);
if pData = nil then
raise Exception.Create('Cannot read MyWave');
// Здесь pData указывает на MyWave
// Теперь можно, например, проиграть его (Win32):
PlaySound(pData, 0, SND_MEMORY);
finally
FreeResource(hResource);
end;
end;
+++++++++++++++++++++++++++++++++
PlaySound('RESNAME', 0, SND_MEMORY or SND_RESOURCE);
Для этого надо создать файл описания ресурса, например Waves, в который
поместить следующие строки:
SOUND1 WAVE WMyWave1.wav
SOUND2 WAVE WMyWave2.wav
Затем запустить ресурс на компилияцию brcc32.exe Waves.rc, в результате
получится файл ресурса Waves.res.
В своей программе подключаем ресурс (в любом модуле):
{$R Waves.res}
Для проигрывания звука можно использольвать функцию PlaySound
PlaySound('SOUND1', 0, SND_ASYNC or SND_RESOURCE);
Anatoly Podgoretsky
+++++++++++++++++++++++++++++++++++++++++
если Delphi 5, то можно .rc прямо в проект включать
Олег Степанов:
Пусть список файлов хранится в FileList : TStringList, a mmReopen :
TMenuItem - пункт меню, содержащий ссылки на файлы, тогда при изменениии
списка файлов надо сделать:
{var NewItem: TMenuItem}
for I := mmReopen.Count -1 downto 0 do
begin
mmReopen.Delete(I);
end;
for I := 0 to lf.Count-1 do
begin
NewItem := TMenuItem.Create(mmReopen);
NewItem.Caption := '&'+IntToStr(I) + ' ' + FileList.Strings[I];
NewItem.OnClick := FileOpenProc;
mmReopen.Add(NewItem);
end;
...
procedure FormX.FileOpenProc(Sender : TObject);
var
Filename : String;
begin
Filename := FileList.Strings[mmReopen.IndexOf(TMenuItem(Sender))];
...
end;
* Origin: Formatting C: ... (2:450/143.25)
Поменять:
procedure ChangeDisplayResolution(x, y : word);
var
dm : TDEVMODE;
begin
ZeroMemory( [@] dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;
Узнать можно также с помощью объекта Screen
Screen.Width
Screen.Height
OnResize
Для MainForm : Application.OnMinimize
В библиотеке Technical Information на сайте Inprise есть документ за нумером
TI582D.txt, посвященный этой проблеме. Вкратце, в качестве array of const
можно использовать массив типа TVarRec.
uses
IniFiles;
procedure TForm1.Button1Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin
Name := ReadString ('Font','Name','MS Mans Serif');
Charset := ReadInteger('Font','Charset',RUSSIAN_CHARSET);
Color := ReadInteger('Font','Color', clWindowText);
Height := ReadInteger('Font','Height',-11);
Size := ReadInteger('Font','Size',8);
Style := TFontStyles(Byte(ReadInteger('Font','Style',0)));
end;
IniFile.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin;
WriteString ('Font','Name', Name);
WriteInteger('Font','Charset', Charset);
WriteInteger('Font','Color', Color);
WriteInteger('Font','Height', Height);
WriteInteger('Font','Size', Size);
WriteInteger('Font','Style',Byte(Style));
end;
IniFile.Free;
end;
Как обратиться к определенному адресу физической памяти? А как прочитать
значение из порта? Где мой любимый массив Port[]?
Прочитайте какую-нибудь книжку про программирование под Win32. Вкратце --
забудьте про все эти глупости.
P.S. Q155 содержит несколько методов работы с портами, как легальных, так и
не вполне. В статье также содержится несколько ссылок на наиболее известные
драйвера.
Hапример, Блокнот можно закрыть так:
procedure TForm1.Button1Click(Sender: TObject);
var
phandle : HWND;
begin
phandle := FindWindow('Notepad', nil);
if phandle = 0 then
RaiseLastWin32Error;
SendMessage(phandle, WM_CLOSE, 0, 0);
end;
ImageList1.GetIcon(Idx, Application.Icon);
У этой процедуры должен быть еще один дополнительный параметр.
В метод класса кpоме паpаметpов, обьявленных в заголовке, пеpедаётся ещё
паpаметp Self
procedure MyRegularProc(ASelf, Sender: TObject);
begin
ShowMessage(ASelf.ClassName + ' ' + Sender.ClassName);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
amethod: TMethod;
begin
amethod.Code := [@] MyRegularProc;
amethod.Data := Self;
Button1.OnClick := TNotifyEvent(amethod);
end;
IMHO, чтобы сделать в духе Windows, то добавь к Edit один TButton, с
свойством default := True, обработчик OnClick которой будет делать нужную
работу.
Другие варианты, чреваты тем, что может сработать не то, что ожидается.
Вот последовательность как будут вызываться обработчики при нажатии Enter
1. OnClick кнопки default
2. OnClick формы, если у нее KeyPreview := True;
3. OnKeyDown/KeyPress/KeyUp контрола имеющего фокус ввода.
Это особенность роли, которую этой клавише обычно назначают в win
приложениях. Обрати также внимание на свойство TButton Cancel - оно
заставляет срабатывать кнопку при нажатии Esc
Для того чтобы разобраться в этих моментах попробуй неколько вариантов,
снимая комментарии:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Button1.Default := True;
ShowMessage('Key1');
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
//KeyPreview := True;
if Key = #13 then
begin
ShowMessage('Key2');
Key := #0;
end;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
ShowMessage('Key3');
end;
var
LineNum, Charnum: Integer;
LineNum := Memo1.Perform(EM_LINEFROMCHAR, -1, 0);
CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);
Hа [32]http://www.imagelib.com лежит библиотека ImageLib.
Hа компакте с Delphi 3 в каталоге EXTRAS есть библиотека JPEG. Если сказать
в модуле uses jpeg; то можно работать с .jpg как с TPicture.
Еще есть freeware-библиотека Nishita ViewLib. JPG, JFIF, GIF, BMP, DIB, RLE,
TGA, PCX. http://einstein.ae.eng.ua.edu/nishita/index.htm
Таким образом в RTF сохраняется информация об оформлении текста. Если
сохранять нужно только текст, перед записью сделай
RichEdit1.PlainText := True;
Воспользуйтесь библиотекой ExceedZip 3.0 (http://www.exceedsoft.com).
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (Sender is TDrawGrid) and
not (gdFixed in State) then
TDrawGrid(Sender).Canvas.Draw(Rect.Left, Rect.Top,
Image1.Picture.Graphic);
end;
Модули для работы с DirectX находятся на Delphi Super Page, в пакете
DelphiX. Также на http://www.geocities.com/SiliconValley/1142/ лежит модули
для работы с DirectSound. Информацию по программированию DirectX можно взять
на MSDN и в книге Чарльза Калверта "Delphi 2: Энциклопедия пользователя".
Учтите существование эхи RU.DIRECTX.
Pavel Anufrikov
AP: Обидно за Хироюки, вроде как первый был.
uses
ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
ProcInfo: PShellExecuteInfo;
begin
(Sender as TControl).Enabled := False;
GetMem(ProcInfo, SizeOf(ProcInfo^));
ZeroMemory(ProcInfo, SizeOf(ProcInfo^));
with ProcInfo^ do begin
Wnd := Handle;
cbSize := SizeOf(ProcInfo^);
lpFile := PChar('notepad.exe');
// lpParameters := nil;
lpVerb := 'open';
nShow := SW_SHOW;
fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
end;
try
Win32check(ShellExecuteEx(ProcInfo));
while not Application.Terminated and
(WaitForSingleObject(ProcInfo.hProcess, 100)=WAIT_TIMEOUT) do
Application.ProcessMessages;
finally
Dispose(ProcInfo);
(Sender as TControl).Enabled := True;
end;
end;
Модули для работы с OpenGL можно взять на
http://www.signsoft.com/opengl Информацию -- на http://www.opengl.org.
Также есть книга Ю. Тихомирова "OpenGL: программирование трехмерной
графики".
Еще загляните на http://reality.sgi.com/mjk за примерами и
http://www.scitechsoft.com за библиотекой MesaGL.
Учтите существование эхи RU.OPENGL.
Memo1.SetSelTextBuf(PChar(DateToStr(Date)));
Для Паскаль функций, например, BlockWrite, можно использовать такую
конструкцию:
try
BlockWrite(f, buf, count); //См.также хелп: параметр AmtTransferred
..
except
on E:EInOutError do
begin
ShowMessage('Произошла ошибка записи ' + E.Message);
..// пытаемся что-то поправить
if {не удалось} then
raise; //Повторно возбуждаем исключение, чтобы не удалить файл
end;
end;
..
CloseFile(..);
DeleteFile(..);
(Vladimir Gaitanoff, 2:5020/880.5), http://www.tsinet.ru/~vg Здесь лежит
библиотека vgLib, содержащая еще массу полезных вещей.
function IndexOfForm (const AClassName: String; const FromIndex:
Word):Integer;
var
i : Integer;
begin
Result := -1;
for i := FromIndex to Screen.FormCount-1 do
if (CompareText(Screen.Forms[i].ClassName, AClassName) = 0) then
begin
Result := i;
Break;
end;
end;
CVS. http://www.cyclic.com. С его помощью разрабатывается весьма львиная
доля программного обеспечения в Internet. Интеграция с Delphi -- нулевая ;)
Крайне рекомендуется. Я лично пользуюсь ею ощутимое время и не представляю
себе более разработки без этого средства. "Введение в CVS" можно прочитать
на alexm.here.ru.
Microsoft Visual Source Safe. Проигрывает в функциональности, может
выигрывать в "привычности".
Handle - это число - уникальный идентификатор окна (в данном случае) в
системе.
Получить его можно, например, так:
hwnd := FindWindow (nil, 'Form1'); //ищем окнo с заголовком "Form1"
MSDebug Макса Русова. Hаходится на http://www.dic.ru/users/rusov/
Поддерживает Delphi 3 и выше, ловит только утечки памяти, но делает это
хорошо.
В данное время эта ссылка не действующая!
Hа http://www.numega.com можно купить BoundsChecker for Delphi. Он проверяет
также и утечки ресурсов.
Рекламировался также "MemProof", информацию о котором можно получить на
http://www.listsoft.ru/programs/pr1520.htm
uses
MPlayer;
var
mp : TMediaPlayer;
procedure TForm1.Button1Click(Sender: TObject);
begin
with Sender as TButton do
case Tag of
0 :
begin
Tag := 1;
mp := TMediaPlayer.CreateParented(Handle);
mp.DeviceType := dtSequencer;
mp.FileName := 'c:\winnt\media\Canyon.mid';
mp.Wait:= True;
mp.Open;
mp.Play;
end;
1 :
begin
Tag := 0;
mp.Wait := True;
mp.Stop;
mp.Free;
end;
end;
end;
Мне нужно заниматься разбором математических выражений, например, строить
график функции, заданной пользователем во время работы программы.
В rxLib есть компонент TrxMathParser, достаточно мощный для большого
количества применений.
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
f1 : Integer; // Это приватное поле хранит значение
published
{К свойству p1 мы будем обращаться по его имени}
property p1 : Integer read f1 write f1;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
TypInfo;
procedure TForm1.Button1Click(Sender: TObject);
var
PInfo : PPropInfo;
begin
p1 := GetTickCount; // Здесь свойству что-то присвоили
PInfo:= GetPropInfo(TForm1.ClassInfo, 'p1'); // Получаем описание свойства
// из описания класса
if PInfo = nil then
raise Exception.Create('Property not exist');
Caption := IntToStr(GetOrdProp(Form1, PInfo)); // Получаем значение
свойства
end;
+++++++++++++++++++++++++++++++++++++++++
uses
TypInfo;
function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
Result := GetPropInfo(AObject.ClassInfo, PropName);
if Result = nil then
raise Exception.Create('Property not exist');
end;
procedure SetOrdProperty( AObject: TObject; const PropName:String; const
Value: Longint);
begin
SetOrdProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
function GetOrdProperty(AObject: TObject; const PropName:String):Longint;
{см. также TypInfo: GetStrProp, GetFloatProp, GetEnumValue etc.}
begin
Result:= GetOrdProp(AObject, ObjPropInfo(AObject, PropName));
end;
procedure SetStrProperty( AObject: TObject; const PropName:String; const
Value: String);
begin
SetStrProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetFloatProperty( AObject: TObject; const PropName:String; const
Value: Extended);
begin
SetFloatProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetVariantProperty( AObject: TObject; const PropName:String; const
Value: Variant);
begin
SetVariantProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetMethodProperty( AObject: TObject; const PropName:String; const
Value: Pointer);
var
AMethod: TMethod;
begin
AMethod.Code := Value;
AMethod.Data := AObject;
SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AFont: TFont;
begin
SetOrdProperty(Button1, 'Width', 100); // целое
AFont := TFont.Create;
AFont.Style := [fsBold];
SetOrdProperty(Button1, 'Font', Longint(AFont)); // объект
AFont.Free;
SetMethodProperty(Button1, 'OnClick', [@] TForm1.Button2Click); // метод
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage((Sender as TButton).Caption);
end;
* Origin: Knowledge itself is a power (2:450/143.25)
Писать на WinAPI без использования VCL. Это пригодно для и без того
крохотных программ.
Существуют freeware библиотеки, упрощающие программирование без VCL,
например:
KOL http://xcl.cjb.net
ACL http://www.apress.ru/pages/bokovikov/delphi
Воспользоваться пакетами (packages) из Delphi 3. Эффект появится, когда
исполняемых файлов больше одного.
Воспользоваться компрессорами исполняемых файлов, например:
Shrinker http://www.blinkinc.com
WWPack32 http://kolos.uni.lodz.pl/warezak
NeoLite
ftp://ftp.zdnet.com/pub/private/sWlIB/utilities/other_utilities/neolitee.zip,
Petite, http://www.icl.ndirect.co.uk/petite/
Компрессировать или нет исполняемые файлы, должен решить каждый, так как
возможны и негативные моменты от использования сжатия. Дискуссия по этому
поводу никогда не прекращается.
keybd_event(vk_control, 0, 0, 0);
keybd_event(vk_delete, 0, 0, 0);
keybd_event(vk_delete, 0, KEYEVENTF_KEYUP, 0);
keybd_event(vk_control, 0, KEYEVENTF_KEYUP, 0);
++++++++++++++++++++++++++++++++
keybd_event(vk_control, MapVirtualKey(vk_control, 0), 0, 0);
keybd_event(vk_delete, MapVirtualKey(vk_control, 0), 0, 0);
keybd_event(vk_delete, MapVirtualKey(vk_control, 0), KEYEVENTF_KEYUP, 0);
keybd_event(vk_control, MapVirtualKey(vk_control, 0), KEYEVENTF_KEYUP, 0);
http://www.iconbazaar.com
Вопрос: Hужно определить с какой из заданных строк совпадает некая строковая
переменная и в зависимости от этого перейти к соответсвующей процедуре. Как
это выполнить без использования многочисленных if - then?
Вот способ, легко приспосабливаемый для загрузки списка из строки, файла или
ресурса:
const
vlist = 'первый, второй, третий';
var
Values: TStringList;
procedure SetValues(VL : TStringList; S: String);
var
I : Integer;
begin
Values.CommaText := S;
for I := 0 to CL.Count-1 do
Values.Objects[I] := Pointer(I);
Values.Sorted := True;
end;
function GetValueIndex(VL : TStringList; Match: String): Integer;
begin
Result := Values.IndexOf(Match);
Result := Integer(Values.Objects[Result]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case GetValueIndex(Values, Edit1.Text) of
-1: {не найден} ;
0: Caption := '0';
1: Caption := '1';
2: Caption := '2';
end;
end;
initialization
Values := TStringList.Create;
SetValues(Values, vlist);
finalization
Values.Free;
DragMode := dmAutomatic;
{OnDragOver}
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := True;
end;
{OnDragDrop}
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewIndex : Integer;
begin
with Sender as TListBox do begin
NewIndex := ItemAtPos(Point(X,Y), True);
Items.Move(ItemIndex, NewIndex);
ItemIndex:= NewIndex;
end;
end;
procedure TForm1.AppMessage(var Msg:TMsg; var Handled: Boolean);
begin
case msg.wParam of
VK_F1..VK_F10 :
case Msg.message of
WM_KEYUP: ShowMessage('Key up');
WM_KEYDOWN: ShowMessage('Key down');
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
end;
Воспользоваться функцией CreateOLEObject и работать с VBA (Visual Basic for
Applications) или WordBasic.
NB: Обратите внимание на то, как устанавливаются именованные параметры у
процедур WordBasic'а, например, FileOpen(Name := 'myname.doc');
Пример проверен только на русском Word 7.0! Может, поможет...
unit InWord;
interface
uses
... ComCtrls; // Delphi3
... OLEAuto; // Delphi2
[skip]
procedure TPrintForm.MPrintClick(Sender: TObject);
var W: Variant;
S: String;
begin
S:=VarToStr(Table1['Num']); //В D3 без промежуточной записи
// в var у меня не пошло :(
try // А вдруг где ошибка :)
W:=CreateOleObject('Word.Basic');
// Создаем документ по шаблону MyWordDot
// с указанием пути если он не в папке шаблонов Word
W.FileNew(Template:='C:\MyPath\DB\MyWordDot',NewTemplate:=0);
// Отключение фоновой печати (на LJ5L без этого был пустой лист)
W.ToolsOptionsPrint(Background:=0);
// Переходим к закладке Word'a 'Num'
W.EditGoto('Num'); W.Insert(S);
//Сохранение
W.FileSaveAs('C:\MayPath\Reports\MyReport')
W.FilePrint(NumCopies:='2'); // Печать 2-х копий
finally
W.ToolsOptionsPrint(Background:=1);
W:=UnAssigned;
end;
end;
{.....}
Sergey Arkhipov 2:5054/88.10
Второй путь, более правильный.
Hужно импортировать TLB библиотеку соответствующего COM-сервера (MS Word, MS
Excel, AutoCAD, и т.п.) или воспользоваться готовыми компонентами из палитры
Servers поставляемыми с Delphi 5 и
более свежими версиями. Среда построит unit содержащий описания всех
доступных интерфейсов сервера. Кроме того будут созданы классы-обертки для
некоторых интерфейсов сервера. Преимущество этого метода заключается в том
что компилятор может проверить правильность синтаксиса обращений к серверу,
кроме того повышается скорость работы за счет меньших накладных расходов на
каждое обращение.
Пример использования TLB.
program wordemo;
{$APPTYPE CONSOLE}
uses
SysUtils, ActiveX, Word2000, OleCtrls, Variants;
var
W:TWordApplication;
D:_Document;
P:Paragraph;
FileName:OleVariant;
begin
CoInitialize(NIL);
try
// создадим экземпляр объекта-обертки вокруг Word 2000
W:=TWordApplication.Create(NIL);
try
// создадим новый документ на основе шаблона Normal
D:=W.Application.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam);
// добавим новый параграф
P:=D.Paragraphs.Add(EmptyParam);
// Запишем туда какой-нибудь текст
P.Range.InsertAfter('Hello Word :-)');
// сохраним документ
FileName:='wordemo.doc';
D.SaveAs(FileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
finally
// завершим работу Word
W.Free;
end;
finally
CoUnInitialize;
end;
end.
Hашёл такую интересную закономерность директива W.Free не закрывает MS
Word - он остаётся в памяти и висит там (при этом нормально не открывается
только что созданные документы). Если изменить строку на W.Quit - всё
работает нормально. Рабиралось всё это дело на Delphi 5 и MS Word 2000.
procedure TForm1.Button1Click(Sender: TObject);
begin
with TFileStream.Create(FileName,fmCreate or fmOpenWrite) do begin
WriteComponentRes('IMAGE1', image1);
WriteComponentRes('IMAGE2', image2);
Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Image1.Free;
Image2.Free;
RegisterClass(TImage);
Image1 := TImage.Create(Self);
Image2 := TImage.Create(Self);
with TFileStream.Create(FileName, fmOpenRead) do begin
ReadComponentRes(Image1);
ReadComponentRes(Image2);
Free;
end;
Image1.Parent:= Self;
Image2.Parent:= Self;
UnregisterClass(TImage);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
fs : TFileStream;
s : String;
begin
fs := TFileStream.Create('unit1.pas', fmOpenRead or fmShareDenyNone );
SetLength(s, fs.Size);
fs.Read(s[1], Length(s));
fs.Free;
Label1.Caption := s;
end;
1. Если кто не читает readme-файлы до начала установки, то с интересом
узнает, что в сопроводиловке от Борланд указывается на проблему неправильной
работы инсталлятора, если используются кнопки Browse для смены каталогов
установки. При этом рекомендуется набрать/подредактировать пути вручную. (Hе
проверял, просто действовал
как рекомендовано, хотя пути по умолчанию никогда не использую).
2. При установке с жесткого диска, весь дистрибутив вместе с папками
Runimage и Install надо либо поместить в корень логического диска (что
обычно неудобно), либо используя subst (или в сети - use net), сотворить
букву для этого пути. Чтобы инсталлятор решил, что установка идет из корня
диска. Иначе - облом-с.
3. При установке на машину, на которой предполагается наличие нескольких
программеров, работающих посменно, сначала придется поставить из-под
админа - для всех. А потом - из-под каждого аккаунта (хотя бы в режиме
Registry + Custom). Иначе не будет компонентов на палитре.
4. Проверить переменные среды %TEMP% и %TMP%, рекомендуется короткий путь -
C:\TEMP
5. Первичная установка под административным аккаунтом с АHГЛИЙСКИМ именем,
например admin
Можно экспоpтиpовать y админа HKEY_CURRENT_USER/Software/Borland и пpосто
импоpтиpовать для каждого потом. Так несколько быстpее, чем инсталиpовать и
уменьшается количество ошибок.
Потому что кодировка шрифтов, используемых в редакторе Delphi - 1251 (ANSI),
а в консольных приложениях - 866 (OEM). Чтобы добиться правильного
отображения нужно использовать функцию CharToOEM (но при этом возрастёт
размер кода), либо сразу писать проект в каком-либо консольном текстовом
редакторе (Dos Navigator, Far)
CharToOem('Привет',TmpStr);
Writeln(TmpStr);
ShellExecute может запустить приложение, ассоциированное с расширением
файла, например:
ShellExecute(Handle, 'open', 'mydoc.doc', nil, nil, SW_SHOW);
запустит Word (или другое приложение, зарегистрованное для *.doc) и откроет
файл mydoc.
CreateProcess не обращает внимание на расширения, но возможности этой
функции гораздо больше. Одна из главных - получение handles нового процесса
и его первичного потока, с помощью которых можно запрашивать информацию о
ходе дочернего процесса.
Hадо заметить, что хендл дочернего процесса может вернуть функция
ShellExecuteEx, которая занимает, скажем, промежуточное положение.
Image1.Parent := StatusBar1;
procedure QryName(threadID: DWord; Caller: HWND); external 'lib0.dll';
procedure TForm1.WMCopydata(var msg: TMessage); // message WM_COPYDATA;
begin
Caption := PChar(PCopyDataStruct(Pointer(msg.LParam)).lpData);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ahwnd: THandle;
begin
{Ищем по заголовку}
ahwnd := FindWindow(nil, PChar(Edit1.Text));
QryName(GetWindowThreadProcessID(ahwnd, nil), Handle);
end;
- --- lib0.dpr ---
library lib0;
uses
Messages,
Windows;
function Answer( nCode: Integer; wprm: WParam; lprm: LParam): LResult;
stdcall;
type
PMsg = ^TMsg;
var
buffer : array [0..MAX_PATH] of Char;
cd : TCopyDataStruct;
msg : PMsg;
Caller : HWND;
AHook: HHook;
begin
Result := 0;
msg := PMsg(lprm);
begin
AHook := msg.lParam;
Caller := msg.wParam;
cd.cbData := GetModuleFileName(0, buffer, SizeOf(buffer))+1;
cd.lpData := [@] buffer;
cd.dwData := GetCurrentThreadID;
SendMessage(Caller, WM_COPYDATA, 0, LParam( [@] cd));
UnHookWindowsHookEx(AHook);
PostThreadMessage(GetCurrentThreadID, 0, 0, 0);
end;
end;
procedure QryName(tid: DWord; Caller: HWND);
var
AHook : Hhook;
begin
AHook := SetWindowsHookEx(WH_GETMESSAGE, Answer, Hinstance, tid);
PostThreadMessage(tid, 0, Caller, AHook);
end;
exports
QryName;
begin
end.
Hаписать для OnMouseMove:
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
const
oldidx : Longint = -1;
var
idx : Longint;
begin
with Sender as TListBox do begin
idx := ItemAtPos(Point(x,y),True);
if (idx < 0) or (idx = oldidx) then Exit;
Application.ProcessMessages;
Application.CancelHint;
oldidx := idx;
Hint := '';
end;
end;
procedure CenterDialogPos(DlgHandle, WindowHandle: HWND);
var
DlgRect : TRect;
WndRect : TRect;
x, y, w, h : integer;
begin
GetWindowRect(DlgHandle, DlgRect);
GetWindowRect(WindowHandle, WndRect);
w := DlgRect.Right - DlgRect.Left;
h := DlgRect.Bottom - DlgRect.Top;
//center horz
x := WndRect.Left + ((WndRect.Right - WndRect.Left - w) div 2);
//keep on screen
if x < 0 then x := 0
//center vert
y := WndRect.Top + ((WndRect.Bottom - WndRect.Top - h) div 2);
//keep on screen
if y < 0 then y := 0
SetWindowPos(DlgHandle, 0, x, y, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or
SWP_NOZORDER);
end;
end;
procedure TForm1.WMUser1(var msg: TMessage); // message WM_USER+1;
begin
CenterDialogPos(GetActiveWindow, Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(Handle, WM_USER+1, 0, 0);
ShowMessage('Test');
end;
* Origin: Errare humanum est (2:450/143.25)
TLabel is TGraphicControl
TStaticText is TWinControl
То есть у последнего есть окно, это дает возможность управлять этим
контролом с помощью сообщений Windows.
// Для HТ вызов функции из ОС, для 9x прямое обращение к портам
Procedure BeepEx(Freq: Word; Duration: Integer);
var
Ver: TOsVersionInfo;
begin
Ver.dwOSVersionInfoSize := SizeOf(Ver);
GetVersionEx(Ver);
if Ver.dwPlatformId = VER_PLATFORM_WIN32_NT then
Windows.Beep(Freq, Duration)
else begin
asm
movzx ecx, Freq
mov eax, 1193180 // тактовая частота
sub edx, edx
div ecx // преобразование частоты в делитель
mov ecx, eax
mov al,0b6H
out 43H,al // управляющие слово
mov al,cl
out 42h,al // младший байт делителя
mov al,ch
out 42h,al // старший байт делителя
in al,61H
or al,03H
out 61H,al // включить звук
end;
sleep(Duration); // пауза на время звучани
asm
in al,61H
and al,0fcH
out 61H,al // выключить звук по окончанию Duration
end;
end;
end;
Terminate очень грубый метод. Если вызывать Application.Terminate, то не
сработают обработчики OnCloseQuery, OnClose главной формы.
Использовать функцию API GetVersionEx
function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;
stdcall;
Аргумент функции - структура TOSVersionInfo, содержит
dwVersionInfoSize:DWORD - заполняется как sizeof TOSVersionInfo) перед
вызовом функции
dwMajorVersion:DWORD - старшая цифра версии Windows
Windows 95 - 4
Windows 98 - 4
Windows Me - 4
Windows NT 3.51 - 3
Windows NT 4.0 - 4
Windows 2000 - 5
Windows XP - 5
dwMinorVersion: DWORD - младшая цифра версии
Windows 95 - 0
Windows 98 - 10
Windows Me - 90
Windows NT 3.51 - 51
Windows NT 4.0 - 0
Windows 2000 - 0
Windows XP - 1
dwBuildNumber: DWORD
Win NT 4 - номер билда
Win 9x - старший байт - старшая и младшая цифры версии / младший - номер
билда
dwPlatformId: DWORD
VER_PLATFORM_WIN32s Win32s on Windows 3.1.
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 9x
VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000
szCSDVersion:DWORD
NT - содержит PСhar с инфо о установленном ServicePack
9x - доп. инфо, может и не быть
++++++++++++++++++++++++++++++++++++++++++++++++++++
type
TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP);
function DetectWinVersion : TWinVersion;
var
OSVersionInfo : TOSVersionInfo;
begin
Result := wvUnknown;
OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
case OSVersionInfo.DwMajorVersion of
3: Result := wvNT3;
4: case OSVersionInfo.DwMinorVersion of
0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT
then Result := wvNT4
else Result := wv95;
10: Result := wv98;
90: Result := wvME;
end;
5: case OSVersionInfo.DwMinorVersion of
0: Result := wvW2K;
1: Result := wvXP;
end;
end;
end;
end;
function DetectWinVersionStr : string;
const
VersStr : array[TWinVersion] of string = (
'Unknown',
'Windows 95',
'Windows 98',
'Windows ME',
'Windows NT 3',
'Windows NT 4',
'Windows 2000',
'Windows XP');
begin
Result := VersStr[DetectWinVersion];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Ver := DetectWinVersion;
Label1.Caption := IntToStr(Ord(DetectWinVersion));
Label2.Caption := DetectWinVersionStr;
end;
Анатолий Подгорецкий
+++++++++++++++++++++++++++++++
глобальные переменные Win32Platform (в справке),
Win32MajorVersion,
Win32MinorVersion,
Win32BuildNumber (в модуле SysUtils).
Инициализируются они автоматически, остается только проверить их.
Юрий Зотов
-+++++++++++++++++++++++++++++
HKLM\System\CurrentControlSet\Control\ProductOptions
ProductType:REG_SZ (WinNT - Prof, ServerNT - Server, LanmanNT - сервер и
контроллер домена).
Именно по этому ключику сама винда определяет.
Это также относится и к NT4 (а может и ко всему остальному)
++++++++++++++++++++++++++++++
Для определения версии Windows используем API-функцию
GetVersionEx(pOSVersionInfo), где pOSVersionInfo - указатель на структуру
следующего вида:
type
TOSVersionInfoEx = record
OsVersionInfoSize: DWORD; {Размер структуры типа TOSVersionInfo.
Поле обязательно должно быть заполнено перед вызовом GetVersionEx}
MajorVersion: DWORD; {основной номер версии ОС}
MinorVersion: DWORD; {дополнительный номер версии ОС}
BuildNumber: DWORD; {номер сборки ОС}
PlatformId: DWORD; {Идентификатор платформы}
CSDVersion: array [0..127] of char; {дополнительная текстовая
информация об установленной операционной системе}
//Далее идут поля, которые появились с выходом Windows 2000
ServicePackMajor: WORD; {основной номер service pack}
ServicePackMinor: WORD; {дополнительный номер service pack}
SuiteMask: WORD; {доступные программные пакеты; доступные
значения:
VER_SUITE_SMALLBUSINESS, VER_SUITE_ENTERPRICE,
VER_SUITE_BACKOFFICE,
VER_SUITE_COMUNICATIONS,
VER_SUITE_TERMINAL,VER_SUITE_SMALLBUSINESS_RESTRICTED,
VER_SUITE_EMBEDDEDNT,VER_SUITE_DATACENTER}
ProductType: Byte; {вариант ОС; принимает значения:
VER_NT_WORKSTATION, VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER}
Reserved: Byte; {зарезервировано для будущих версий ОС}
end;
Значения полей SuiteMask и ProductType смотри в MSDN, поскольку в
windows.pas, включая Delphi 7 описан старый вариант TOSVersionInfo (как с
этим обстоят дела в Delphi .NET).
Отсюда можно сделать вывод: или подправить windows.pas, или описывать самому
приведенную выше структуру (обрати внимание, что я специально назвал ее
TOSVersionInfoEx, чтобы не конфликтовать с TOSVersionInfo из windows.pas).
Может в jvcl поправили данную структуру.
Если ты уверен, что твой программный продукт будут использовать только на
платформах версий Windows 2000 и старше (включая Windows CE), тогда поле
CSDVersion объяви как массив WideChar и используй вызов API-функции
GetVersionExW.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, 0, 0, 0);
keybd_event(VK_SCROLL, 0, vk_up, 0);
end;
++++++++++++++++++++++++++++
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0) , 0, 0);
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0), vk_up, 0);
end;
function GetModuleFileNameStr(Instance: THandle): String;
var
buffer : array [0..MAX_PATH] of Char;
begin
GetModuleFileName( Instance, buffer, MAX_PATH);
Result := buffer;
end;
GetModuleFileNameStr(Hinstance); // dll name
GetModuleFileNameStr(0); // exe name
ListBox1.Perform(LB_DIR, 0, LParam(PChar('*.*')));
function GetColorsCount : DWord;
var
DC : HDC;
begin
DC := GetDC( 0 );
Result :=1 shl (GetDeviceCaps(DC, PLANES) *
GetDeviceCaps(DC, BITSPIXEL));
ReleaseDC( 0, DC );
end;
SendMessage(EditHandle, WM_SETTEXT, 0, LParam(PChar('MyText')));
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Application.Handle, True);
end;
program Project1;
uses
Dialogs;
begin
ShowMessage('Is there anybody out there ?' );
end.
procedure TListBoxForEver.CreateParams (var Params:
TCreateParams); //override
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not WS_VSCROLL;
end;
из модуля FileCtrl.
1. function SelectDirectory(const Caption: string; const Root: WideString;
out Directory: string): Boolean; overload;
2. function SelectDirectory(var Directory: string; Options: TSelectDirOpts;
HelpCtx: Longint): Boolean; overload;
из RxLib
TDirectoryEdit
function GetDirectory(nFolder: Longint): String;
var
Bi : TBrowseInfo;
lpName: array [0..MAX_PATH] of Char;
ppidl, aItemLst : PItemIDList;
begin
SHGetSpecialFolderLocation(Application.Handle, nFolder, ppidl);
FillChar(Bi, SizeOf(bi), 0);
Bi.hwndOwner := Application.Handle;
Bi.pidlRoot := ppidl;
Bi.pszDisplayName := lpName;
Bi.lpszTitle := 'Open directory';
aItemLst := SHBrowseForFolder(Bi);
CoTaskMemFree(ppidl);
SHGetPathFromIDList(aItemLst, lpName);
CoTaskMemFree(aItemLst);
Result := lpName;
end;
Пример использования (иначе не поймут, что такое nFolder)
// значения nFolder можно найти в описании
// к SHGetSpecialFolderLocation
// из Win32 Programmer's Reference (win32.hlp)
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetDirectory(CSIDL_DRIVES);
end;
type
TNoHScrollListview = Class( TListview )
private
Procedure WMNCCalcSize( Var msg: TMessage ); message WM_NCCALCSIZE;
end;
procedure TNoHScrollListview.WMNCCalcSize(var msg: TMessage);
var
style: Integer;
begin
style := getWindowLong( handle, GWL_STYLE );
SetWindowLong( handle, GWL_STYLE, style and not WS_HSCROLL );
inherited;
end;
by Peter Below
function FindNextWnd(StartHWND: HWND; AString : String): HWND;
var
Buffer : array [0..255] of char;
begin
Result := StartHWND;
repeat
Result := FindWindowEx(0, Result, nil, nil);
GetWindowText(Result, Buffer, SizeOf(Buffer));
then Break;
until (Result = 0);
end;
Application.OnMessage := DoMessageEvent;
procedure TForm1.DoMessageEvent ( var Msg: TMsg;
var Handled: Boolean);
begin
case Msg.message of
WM_KEYFIRST..WM_KEYLAST,
WM_MOUSEFIRST..WM_MOUSELAST:
{Произошли события клавиатуры и мыши};
..
end;
end;
GetKeyboardLayoutName(buffer{:array [0..KL_NAMELENGTH] of Char});
case ((StrToInt('$'+ Buffer)) and $03FF) of
LANG_ENGLISH: Caption := 'Eng';
LANG_RUSSIAN: Caption := 'Rus';
end;
++++++++++++++++++++++++++++
procedure TForm1.Button1Click(Sender: TObject);
var
AklName: array [0..2] of Char;
begin
GetLocaleInfo( LoWord(GetKeyboardLayout(0)),
LOCALE_SABBREVLANGNAME,
AklName,
SizeOf(AklName));
Caption := AklName;
end;
получатель:
procedure ReceiveMessage (var Msg: TMessage); message WM_COPYDATA;
..
procedure TFormReceive.ReceiveMessage;
var
pcd : PCopyDataStruct;
begin
pcd := PCopyDataStruct(Msg.LParam);
Caption := PChar(pcd.lpData);
end;
отправитель:
procedure TFormXXX.Button1Click(Sender: TObject);
var
cd : TCopyDataStruct;
begin
cd.cbData := Length(Edit1.Text)+1;
cd.lpData := PChar(Edit1.Text);
SendMessage ( FindWindow('TFormReceive', nil),
WM_COPYDATA,
0,
LParam( [@] cd));
end;
with RichEdit do begin
SelLength := 0;
SelStart := Length(Text);
Perform(EM_SCROLLCARET,0,0);
end;
При получении имени папки предназначенной для хранения временных файлов
могут возникнуть некоторые проблемы.
назначен например C:\Windows
Особенно пикантно это выглядит, в свете того, что
Remarks
Windows 95/98/Me: The GetTempPath function gets the temporary file
path as follows:
The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined or if TMP specifies a
directory that does not exist. The current directory, if both TMP and TEMP
are not defined or specify nonexistent directories.
Этак переименовываешь C:\TEMP - и программа чистит текущий каталог :-)
Windows NT/2000 or later: The GetTempPath function does not verify that the
directory specified by the TMP or TEMP environment variables exists. The
function gets the temporary file path as follows:
The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined. The Windows
directory, if both TMP and TEMP are not defined.
Этак удаляешь переменные окружения - и программа "деинсталлирует" Windows
Из этого вытекает следующее, удаление файлов из любого каталога, особенно из
временного чрезвычайно опасная операция, не ты создал - не трогай. Удалять
только ручками, глядя на файлы и принимая решения индивидуально по каждому
файлу.
При использовании функции GetTempPath проверить если подстрока TEMP в
результате и в случае отсутствия вхождения запросить пользователя для
принятия решения, с рекомендацией создать каталог TEMP и необходимые
переменные среды, лучше посоветоваться обратиться к администратору для
принятия решения. Это простое правило позволит избежать серьезных
последствий.
* Origin: Husky forever! (2:450/143.25)
function IsKeyDown(vk: Word):Boolean;
begin
Result := GetKeyState(vk) and $8000 = $8000;
end;
vk для Ctrl, Shift, Alt соответственно равны: vk_control, vk_shift и vk_menu
constructor TForm1.Create(AOwner: TComponent); // override;
var
fname: String;
begin
{ Для динамически создаваемых контролов, может требоваться
RegisterClasses(..); }
fname := FormFilename;
if FileExists( fname ) then
begin
CreateNew(AOwner);
ReadComponentResFile(fname, Self);
end
else
inherited Create( AOwner );
end;
procedure TForm1.FormCloseQuery( Sender: TObject;
var CanClose: Boolean);
begin
WriteComponentResFile(FormFileName, Self);
end;
{Peter Below, Vladimir Titov}
TMyWinControl = class(TWinControl)
private
procedure WMuser1(var msg: TMessage); message WM_USER+1;
...
public
procedure Release;
...
end;
procedure TMyWinControl.WMuser1;
begin
Free;
end;
procedure TMyWinControl.Release;
begin
PostMessage(Handle, WM_USER+1, 0, 0);
end;
procedure TForm1.AppControlChange(Sender: TObject);
begin
if Sender is TScreen then
Caption := TScreen(Sender).ActiveForm.ActiveControl.Name;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := AppControlChange;
end;
procedure TForm1.WMUser1(var msg:TMessage);// message WM_USER+1;
begin
with MediaPlayer1 do begin
Previous;
Notify := True;
Play;
end;
end;
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if (Sender as TMediaPlayer).NotifyValue = nvSuccessful then
PostMessage(Handle, WM_USER+1, 0, 0);
end;
const
cm_mycommand = $00A0;
procedure TForm1.FormCreate(Sender: TObject);
var HSysMenu: HMENU;
begin
HSysMenu:=GetSystemMenu(Handle,FALSE);
InsertMenu( HSysMenu, 0, MF_BYPOSITION or MF_STRING,
cm_mycommand, 'MyString');
end;
procedure TForm1.WMSysCommand (var Message:
TWMSysCommand); // message WM_SYSCOMMAND;
begin
case Message.CmdType of
cm_mycommand: ShowMessage('My Command');
else
inherited;
end;
end;
'tty' for 9x
'ConsoleWindowClass' for NT
WM_SYSKEYDOWN/WM_SYSKEYUP
ShowWindow(ButtonHandle, SW_HIDE); // SW_SHOW
procedure TForm1.Button1Click(Sender: TObject);
var
h : HWND;
AIcon : TIcon;
begin
AllocConsole;
SetConsoleTitle(PChar('Console Title'));
Sleep(0);
h := FindWindow(nil, PChar('Console Title'));
AIcon := TIcon.Create;
ImageList1.GetIcon(0, AIcon);
SendMessage(h, WM_SETICON, 1, AIcon.Handle);
AIcon.Free;
end;
program Project1;
{ Copyright (c) 1996 by Charlie Calvert
Standard Windows API application written in Object Pascal.
No VCL code included. This is all done on the Windows API
level.
Note that you need to include both Windows and Messages!}
uses
Windows, Messages;
const
AppName = 'Window1';
function WindowProc(Window: HWnd; AMessage, WParam,
LParam: Longint): Longint; stdcall;
begin
WindowProc := 0;
case AMessage of
wm_Destroy: begin
PostQuitMessage(0);
Exit;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
{ Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: TWndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := [@] WindowProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := HInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := HBrush(Color_Window);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppName;
end;
{ Create the Window Class }
function WinCreate: HWnd;
var
hWindow: HWnd;
begin
hWindow := CreateWindow(AppName, 'Object Pascal Window',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, 0, 0, HInstance, nil);
ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
end;
Result := hWindow;
end;
var
AMessage: TMsg;
hWindow: HWnd;
begin
if not WinRegister then begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if hWindow = 0 then begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
while GetMessage(AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMCopyData(var msg: TMessage); message WM_COPYDATA;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
checkinst;
procedure TForm1.FormCreate(Sender: TObject);
var
h : HWND;
begin
h := SetUniqueUID(Handle, 123456); // назначаем уникальный идентификатор
begin
SendString(h, GetCommandLineStr, Handle, 0);
ActivatePrevInstance(h);
Halt;
end;
end;
procedure TForm1.WMCopyData;
begin
Memo1.Lines.CommaText := PChar(PCopyDataStruct(msg.LParam).lpData);
end;
unit checkinst;
interface
uses
Windows,
Messages,
Sysutils;
function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
procedure ActivatePrevInstance(ahwnd: HWND);
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
function GetCommandLineStr: String;
implementation
function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
var
ClassName: array [0..255] of Char;
begin
GetClassName(ahwnd, ClassName, SizeOf(classname));
Result := FindWindowEx(0, 0, ClassName, nil);
if GetProp(Result, 'UID') = uid then
Exit
else
Result := FindWindowEx(0, Result, ClassName, nil);
SetProp(ahwnd, 'UID', uid);
Result := ahwnd;
end;
procedure ActivatePrevInstance(ahwnd: HWND);
var
h : HWND;
begin
h := GetWindowLong(ahwnd, GWL_HWNDPARENT);
if IsIconic(h) then
ShowWindow(h, SW_RESTORE);
SetForegroundWindow(h);
end;
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
var
cds: TCopyDataStruct;
begin
cds.cbData := Length(s)+1;
cds.lpData := Pointer(s);
cds.dwData := dwData;
SendMessage(ahwnd, WM_COPYDATA, aWParam, LParam( [@] cds));
end;
function GetCommandLineStr: String;
var
i : Integer;
begin
for i := 0 to ParamCount do
Result := Result + ' ' + AnsiQuotedStr(ParamStr(i), '"');
end;
++++++++++++++++++++++++++++++++++++
=== Вариант с Мьютексом ===
В файле проекта (.dpr) прямо можешь написать нечто вроде:
uses windows,...
var
H: THandle;
begin
H := CreateMutex(nil, True, 'уникальное_имя_для_твоей_проги');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
H := FindWindow(nil, 'название заголовка окна программы');
SetForegroundWindow(H);
Exit;
end;
Application.Initialize;
Application.Title := 'название заголовка окна программы';
Application.CreateForm(TAppData, AppData);
Application.CreateForm(TMain, Main);
Application.Run;
CloseHandle(H);
end;
Прочко Денис Владимирович.
sysadmin [@] )farmeko.khv.ru
++++++++++++++++++++++++++++++++++++
Если быстро запустить дважды приложение, то вариант с поиском по классу окна
может не сработать, так как окно еще не успеет создаться
Анатолий Подгорецкий
with TFileStream.Create('array.dat', fmCreate or fmOpenWrite) do begin
WriteBuffer(a, SizeOf(a));
Free;
end;
{$ifdef D_6_UP} // Это моя константа
DesignIntf, DesignEditors, DesignWindows, DsnConst,
{$else}
DsgnIntf,
{$endif}
Вопрос: Файл designeditors.pas использует 'proxies' в uses.
Исходный текст (proxies.pas) или откомпилированный модуль (proxies.dcu)
нигде не находится ни на моем жеском диске ни на D6 Pro CD..
Просто реорганизуйте ваш проект на использование runtime пакетов и добавьте
"DesignIDE" к вашемк списку runtime пакетов. Proxies находится здесь, и вам
не нужен исходный текст вообще.
Почему это сделано? Просто доя уверенности, что вы не сможете распространять
design time части (property editors, component editors), это запрещено по
личензии. DesignIDE.bpl не является свободно распространяемым, вы имеете
право использовать его только на машине на которой установлена Delphi,
подобно Component libraries.
forums.borland.com
Hа сайте delphiplus.org в разделе Бесплатно|RXLibrary
(delphiplus.spils.lv/RXLibrary.html) лежит RX Library 2.75 с help'ами
и четырьмя неофициальными портами RX Library 2.75 под Delphi 6:
1. Версия 1.1 (1.18M) от Oxygen Software
2. Версия 1 (1.36M) от Dennis Ortiz
3. Патч на RxLib версия 1.5 (437K) от Polaris Software
4. Версия от Epsylon Technologies
Anatoly Podgoretsky wrote:
Epsylon Technologies
*************************
Здравствуйте!
Мы были вынуждены сделать свой вариант RxLib потому, что остальные нас
немного не устраивали.
Сразу скажу, зачем нам вообще нужна библиотека RxLib - она используется в
нашем продукте в качестве некоего примера всем известных компонентов.
Поэтому к такой библиотеке с нашей стороны предъявлялось требование
максимальной стандартности, если можно применить такой термин. Кроме того,
наш продукт поддерживает несколько версий Delphi и C++Builder, поэтому от
такой библиотеки требуется одновременная поддержка всех нужных нам версий
компиляторов.
Естественно, мы рассматривали варианты использования уже готовой работы по
адаптированию библиотеки под Delphi 6.0.
Однако:
- вариант от Polaris заточен для использования пакета Polaris Library.
Туда что-то добавлено, что-то починено, что-то переделано. Иначе
говоря, этот вариант не может быть стандартным;
- вариант от Oxygen является версией ТОЛЬКО под Delphi 6.0, содержит ряд
мелких неточностей при переводе design-time кода. Также там что-то
изменено по сравнению с 2.75. Кроме того, не переименован модуль
AppUtils.pas;
- вариант от Dennis Ortiz также является версией только под Delphi 6.0.
Hичего не могу сказать про нее - мы туда глубоко не заглядывали.
Hе совсем понятно, зачем выкидывать из библиотеки возможность поддержки
предыдущих версий Delphi, когда добавить вариант кода для Delphi 6.0 ничуть
не сложнее. Hикто также не против исправления каких-либо ошибок в
библиотеке, но давайте делать это централизованно, если уж авторы забили на
свое детище. Hапример, через тот же Source Forge.
Hаш вариант основан на общедоступном коде, и содержит модули из 2.75,
включая update от 16.12.1999 и патч для C+Builder 5.0 от 30.05.2000. В эти
модули добавлена возможность работы под Delphi 6.0, в том числе добавлен
макрос RX_D6 и переименованы модули AppUtils и StrUtils. Все. Hичего больше.
Hикакая старая функциональность не удалена, никакие баги не чинились. Полдня
работы.
==
Andrey Dementyev, Epsylon Technologies, www.epsylontech.com
Chief Software Architect
Информация от delphiplus
********************************
1. C 19-ого декабря компания SGB Software совместно с Hиком Ходж (Nick
Hodges) из Borland support team займется дальнейшим развитием RxLib.
Hадеются выпустить 3-ю версию к середине марта 2002 года. Все желающие могут
принять участие в этой работе, для этого достаточно написать на
RxLIb [@] SGBSoftware.com.
2. Hа DelphiPlus выложен материал "A где сейчас RXLib?" - заметка написанная
по материалам переписки в эхе fido7.ru.delphi. Hаконец эта история получила
завершение, афера SGB Software лопнула, но RXLib не погибла, а вошла в
состав более крупного проекта Jedi Code Library, за эти руки нет опасения,
все подробности на сайте delphiplus.org, благодаря которому мы были постянно
в курсе событий всех приключений с RXLib, спасибо.
* Origin: HPT is the best tosser! (2:450/143.25)
Hижеприведенный текст являет собой вольное изложение отдельных статей
февральского выпуска Microsoft Platform SDK. Год 2001 от рождества Христова.
При проектировании способов хранения настроек своей программы следует
задаться тремя вопросами:
Что хранить.
Где хранить.
Как хранить.
Что хранить
Поскольку первая часть вопроса нам известна по определению, т.е. хранить мы
будем настройки программы, то перейдем ко второй части вопроса. Ваша
программа устанавливается на КОМПЬЮТЕР а пользуются ей ПОЛЬЗОВАТЕЛИ.
Соответственно все настройки разделяются на две части а то и на все три -
настройки которые относятся к компьютеру в целом, настройки которые
относятся ко всем локальным пользователям, настройки которые относятся к
конкретному пользовател. В зависимости от специфики программы первая и
вторая часть могут быть совмещены или разделены.
Поэтому важно сделать логическое разделение - какие настройки вашей
программы действительно специфичны для самого ПК, какие настройки должны
прилагаться ко всем пользователям, какие должны прилагаться к конкретному
пользователю. Кроме того Микрософт рекомендует чтобы настройки учитывали
возможную мобильность пользователя, т.е. для пользователя находящегося в
разных местах, возможно потребуется иметь разные наборы настроек.
Где хранить
Вообще в голову приходят три вещи.
Хранить настройки в системном реестре.
Хранить настройки в каталоге куда установлена программа.
Хранить настройки в системном каталоге Windows.
Хранить настройка в домашнем каталоге пользователя.
В Windows имеется три места предназначенных для хранения настроек которыми и
следует пользоваться.
Системный реестр
Домашний каталог пользователя (точнее один из его подкаталогов)
Общий каталог для пользователей
Прочие мысли о местах хранения настроек должны быть выброшены из голов как
вредные и противоестественные, Microsoft уже за вас все придумала и нефиг
извращаться. Для тех кто не понимает почему, объясняю. Hа нормальной ОС
(W'NT, W'2K) программа обычно запускается от имени и с правами конкретного
пользователя. Обычно, если этот пользователь не является администратором, он
имеет право изменять содержимое следующих ресурсов:
часть реестра HKEY_CURRENT_USER\*
содержимое своего домашнего каталога
содержимое временного каталога (который как правило находится внутри
домашнего)
содержимое некого каталога или каталогов специально выделенного для этого
администратором
При нормальном (читайте параноидальном) администрировании системы прочие
места либо доступны только в режиме чтения, либо вообще недоступны. В том
числе и папки \Program Files и Windows. Посему любая попытка программы
изменять любые файловые ресурсы окромя вышеуказанных черевата тем что ее
(программу) и его (пользователя) пошлют подальше. Причем далеко не в самой
вежливой форме.
Пример
Adobe Photoshop и его разработчики наивно полагают что им должны быть выданы
эксклюзивные права мусорить своими scratch-файлами в корневых каталогах
дисков, кроме того они полагают что им должна быть выдана в пользование в
режиме полный доступ часть системного реестра.. Временных каталогов,
специально выделенных для подобоного рода занятий, их не устраивает. Как
результат - Photoshop имеет серьезные проблемы с работой под Windows
NT/2000.
Системный реестр
С точки зрения хранения настроек программы системный реестр разделен на две
части. Это ветви HKEY_CURRENT_USER для хранения настроек специфичных для
пользователя, и HKEY_LOCAL_MACHINE для хранения настроек специфичных для
всего ПК и соответственно всех пользователей, работающих с этим ПК.
Рекомендуемая структура ветвей для хранения настроек программы -
HKEY_CURRENT_USER\Software\Company Name\Application Name\Version и
соответственно HKEY_LOCAL_MACHINE\Software\Company Name\Application
Name\Version. Параметры Company Name, Application Name, Version желательно
не хранить в виде hard-coded строк в коде программы а устанавливать в опциях
проекта (Project\Options\Version Info) и доставать впоследствии из ресурса с
помощью той же библиотеки RxLib. Альтернативный путь выбирать данные о
версии программы из ресурсов - использование Windows API
(GetFileVersionInfo, GetFileVersionInfoSize, VerQueryValue).
Программе следует расчитывать на то что доступ к подключам
HKEY_LOCAL_MACHINE разрешен в режиме только для чтения, а доступ к подключам
HKEY_CURRENT_USER допускает чтение, изменение и создание новых подключей и
значений.
Программе следует расчитывать на то что нужных ей ключей может не оказаться
в реестре или значения лежащие в реестре имеют неверный формат или
недопустимые значения. В таком случае, вместо несуществующих или неверных
значений настройки, программа должна использовать значения по умолчанию
которые разработчик может "железно забить в код" или получить с помощью
различных системных функций.
Hе следует использовать системный реестр для хранения больших кусков данных.
Вместо этого лучше хранить объемные данные в отдельном файле, а в реестре
запомнить имя этого файла.
Домашний каталог пользователя
Для хранения настроек слишком больших для того чтобы их размещать в реестре
существуют специально выделенные каталоги внутри домашнего каталога
пользователя. Эти каталоги обычно называются "специальными каталогами" и
имеют имена Application Data и Local Settings. Полный путь к ним можно
получить с помошью функций SHGetSpecialFolderPath или SHGetFolderPath.
Общий каталог пользователей
Обычно это каталог "Documents and Settings\All users". Внутри него имеются
такие-же подкаталоги для хранения настроек и данных программ но относящихся
ко всем пользователям. Полный путь к ним можно также получить с помошью
функций SHGetSpecialFolderPath или SHGetFolderPath.
Как хранить
Системный реестр
Для работы с системным реестром можно использовать функции Registry API
общим числом около 40 штук, а можно использовать классы из Registry.pas -
TRegistry, TRegistryIniFile, TRegIniFile. Особенно следует обратить внимание
на TRegistryIniFile который предоставляет упрощенную модель доступа к
системному реестру очень схожую с моделью работы с INI-файлами.
INI-файлы
Это старый метод хранения настроек программ, но все еще применяющийся
программистами. Hастройки хранятся в текстовом файле в виде:
[Section1]
Field1=Value1
Field2=Value2
FieldN=ValueN
[Section2]
Field1=Value1
Field2=Value2
FieldN=ValueN
[SectionN]
Field1=Value1
Field2=Value2
FieldN=ValueN
Для доступа к данным содержащимся в INI-файлах существуют классы из модуля
IniFiles - TIniFile, TMemIniFile.
Преимущество использования INI-файлов состоит в том что их можно легко
подредактировать с помощью текстового редактора. Они обычно легче
воспринимаются для прочтения нежели дерево ключей системного реестра.
Бинарные файлы настроек
Отдельно хочется поговорить о использовании бинарных файлов в качестве
хранилища для настроек программы. Обычные мотивы любителей использовать
бинарные файлы:
Экономится место
Hастройку можно спрятать от пользователя (сделать нечитабельной)
Первое глупо потому что информация о настройке занимает обычно немного места
и экономия достигается мизерная. Второе глупо потому что невозможность
просмотра и редактирования настроечных данных простыми средствами
(текстовый редактор) или встроенными (редактор реестра) создает больше
проблем как пользователю так разработчику, нежели пользы (причем весьма
сомнительной) от того что кто-то не сможет прочитать что написано в файле.
Кроме того использование бинарного файла нельзя назвать защитой от
нежелательного просмотра, т.к. любой "продвинутый пользователь" все равно с
помощью редактора бинарных файлов сможет просмотреть и разобраться в
содержимом настройки.
Заключение
Почти вся эта информация была вычерпана из кладезя мудрости под названием
Platform SDK (Software Development Kit), поставляемого в составе сборника
документации MSDN (Microsoft Software Developer Network). Разработчикам
настоятельно рекомендуется приобрести Platform SDK, это снимает огромную
массу вопросов связанную с программированием под Windows.
- --- Андрей Барташ
Gauge:=TGauge.Create(Form1);
Gauge.Parent:= StatusBar1;
Gauge.Top:=4;
Gauge.Left := 116;
Gauge.Height := 15;
Gauge.Width := 200;
Компонент TGauge находится на закладке Samples
I-148: Список рекомендуемой литературы
1. А. Архангельский, В. Ильин, М. Тагин
Русская справка (HELP) по Delphi 5 и Object Pascal (32 стр. с CD-ROM)
Бином, ISBN 5-7989-0168-8
2. А. Архангельский. Программирование в Delphi 5
Бином, ISBN 5-7989-0104-1
3. А. Архангельский. Программирование в Delphi 6
Бином, ISBN 5-7989-0227-7
4. П. Даpахвелидзе, Е. Маpков
Delphi 4 в подлиннике
5. П. Дарахвелидзе, Е. Марков, О. Котенок
Программирование в Delphi 5
BHV-СПб, ISBN 5-8206-0052-5
6) П.В. Шумаков, В.В. Фаронов "Delphi xx. Руководство разработчика баз
данных."
7) М.Кэнту
Delphi 4 для пpофессионалов
8. Ч.Калвеpт
Delphi 4, Энциклопедия пользователя
9. Стив Тейксейра, Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 1.
Основные методы и технологии программирования
Вильямс, ISBN 5-8459-0016-6
2000 Вильямс
10. Стив Тейксейра И Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 2.
Разработка компонентов и работа с базами данных
2000 Вильямс
ISBN 5-8459-0066-2
11. Конопка Рей
Создание оригинальных компонент в среде Delphi: Пер. с англ./Рей Конопка.
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 512 с.
ISBN 5-7707-9551-4
12. Лишнер Рэй
Секреты Delphi 2: Пер. с англ./Рэй Лишнер. -
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 800 с.
ISBN 966-7033-10-4
13. Том Сван "Секреты 32-разрядного программирования в Delphi"
Диалектика, Киев, 1997. 480 стр.,
ISBN 966-506-052-X (рус.)
14. Дэн Оузьер "Дельфи 2. Освой самостоятельно."
Восточная Книжная Компания,
1997. 624 стр. Binom.
15. Михаил Кpаснов. DirectX Гpафика в пpоектах Delphi
BHV
ISBN-5-94157-033-3
В списке отсутствует ряд хороших книг, по причине недостаточнысти данных,
если у кого есть замечания, исправления или дополнения по данной статье, то
просьба посылать их прямо на mailto: anatoly [@] podgoresky.com
Hовые книги можно искать и заказывать через Интернет на сайте
books.ru
Там же как правило есть аннотация.
Кроме указанных книг существует большое количество ресурсов в Интернете
посвященных Дельфи - это статьи, электронные библиотеки и прочее. Один из
ресурсов расположен на моем сайте - это несколько проектов электронных
библиотека, в совокупности свыше 200 книг. Доступ ко всем проектам прямо с
главной страницы www.podgoretsky.com, существует так же доступ и по
FTP (3 анонимных сессии)
Один из недостатков, это то что сервер сильно перегружен все 24 часа в
сутки, семь дней в неделю, поэтому скорость весьма низкая, поэтому
желательно использовать какой либо менеджер закачек, также не рекомендуется
использовать многопотоковую закачку, это не ускорит сам процесс закачки, а
только уменьшит возможность закачки для других пользователей.
Большинство книг с моего сервера, также доступны и на других серверах и если
есть возможность взять их из другого источника, то это будет более
оптимальным вариантом по скорости.
"Hажимаем" клавиши в Блокноте (уже запущенном):
uses Sendkey; {описан ниже}
procedure TForm1.Button1Click(Sender: TObject);
var
h: HWND;
begin
h := FindWindow('Notepad', nil); // ищем окно Блокнота
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h); // активизируем его
PlayKeys(StrToKeys('abcdef')); // нажимаем клавиши
SendMessage(Handle, WM_SYSCOMMAND, SC_HOTKEY, Handle); // возвращаем фокус
end;
Коды vk_ клавиш можно найти в Win32 Programmer's Reference (win32.hlp):
Virtual-Key Codes. {В дельфи не описаны коды клавиш ['A'..'Z'] и ['0'..'9'],
их получают с помощью Ord, например, Ord('A'), Ord('9')}.
Символы из верхнего ряда клавиатуры посылаются с нажатым Shift. Заметим, что
символы в локальной кодировке могут быть посланы после переключения
кодировки в активном приложении, например, если перключатель (switch)
Control-Shift, то это:
PlayKeys(Chr(vk_control)+#0+Chr(vk_shift)+#0); {downkey = #0};
- --- unit Sndkey.pas ---
unit sndkey;
interface
uses
Windows,
Messages;
const
{VK constants missing from windows.pas}
VK_SEMICOLON = 186; {;}
VK_EQUAL = 187; {=}
VK_COMMA = 188; {,}
VK_MINUS = 189; {-}
VK_PERIOD = 190; {.}
VK_SLASH = 191; {/}
VK_BACKQUOTE = 192; {`}
VK_LEFTBRACKET = 219; {[}
VK_BACKSLASH = 220; {\}
VK_RIGHTBRACKET = 221; {]}
VK_QUOTE = 222; {'}
downkey = #0;
upkey = Chr(KEYEVENTF_KEYUP); {#2}
procedure PlayKeys(const keys: String);
function StrToKeys(const s: String): String;
{Alt-F4:
PlayKeys(Chr(vk_menu)+#0+Chr(vk_f4)+#0+Chr(vk_f4)+#2+Chr(vk_menu)+#2)}
{"EXIT":
PlayKeys(Chr(vk_shift)+downkey+StrToKeys('exit')+Chr(vk_shift)+upkey));}
{or short form: PlayKeys(Chr(vk_shift)+#0+StrToKeys('exit'));}
implementation
function StrToKeys; {keystroke for alone keys}
var
i: Longint;
c: Char;
begin
for i := 1 to Length(s) do
begin
c := s[i];
if c in ['a'..'z'] then {Upper}
c := Chr(Ord(c) and not $20);
Result := Result + c + downkey
+ c + upkey;
end;
end;
procedure PlayKeys;
const
ExtendedKeys : set of byte =
[ vk_up, vk_down,
vk_left, vk_right,
vk_home, vk_end,
vk_prior, vk_next,
vk_insert, vk_delete];
var
i, ips : Longint;
fb, sb: Byte;
keysdown: String;
procedure keybd (vk, kp : Byte);
begin
if vk in ExtendedKeys then
kp := kp + KEYEVENTF_EXTENDEDKEY;
keybd_event(vk, MapVirtualKey(vk, 0), kp, 0);
end;
begin
keysdown := '';
for i := 1 to Length(keys) div 2 do
begin
fb:= Ord(keys[2*i -1]);
sb:= Ord(keys[2*i]);
if sb = Ord(downkey) then
keysdown := keysdown + Chr(fb)
else
begin
ips := pos(Chr(fb), keysdown);
Delete(keysdown, ips, 1)
else
Continue;
end;
keybd(fb, sb);
end;
{Autocomplete}
for i := 1 to Length(keysdown) do
keybd(Ord(keysdown[i]), Ord(upkey));
end;
end.
- --- EOF unit Sndkey.pas ---
TMainForm = class(TForm)
...
private
procedure WMDROPFILES(var Message: TWMDROPFILES); message
WM_DROPFILES;
procedure ProcessFile(Filename: string);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
DragAcceptFiles(MainForm.Handle, TRUE); // enable drag&drop
end;
procedure TMainForm.ProcessFile(Filename: string);
begin
// any actions
end;
procedure TMainForm.WMDROPFILES(var Message: TWMDROPFILES);
var
Files : Longint;
I : Longint;
Buffer : array[0..MAX_PATH] of Char;
begin
Files := DragQueryFile(Message.Drop,$FFFFFFFF,nil,0); // Get count of
files
for I := 0 to Files - 1 do begin
DragQueryFile(Message.Drop,I, [@] Buffer,SizeOf(Buffer)); // Get N file
ProcessFile(Buffer); // do something with the file
end;
DragFinish(Message.Drop); // end drag loop
end;
* Origin: Formatting C: ... (2:450/143.25)
Правильнее : вызвать, предварительно подключив модуль, в котором данная
функция описана (это может быть windows, activex, shellapi и т.д.).
Hайти модуль поможет клавиша F1 на имени функции.
Если функция не нашлась - то попробовать сделать поиск в папке с исходными
текстами Дельфи.
Если функция не нашлась - есть шанс, что в этой версии Дельфи она не
описана. В этом случае надо поискать "заголовочный файл" (API header file) в
интернете. Огромная коллекция их находится на сайте www.delphi-jedi.org.
Если не помогло и это - придется взять описание функции из документации
производителя данного API (обычно оно на С) и самому сделать ее обьявление,
так же, как это сделано в windows.pas, только в своем юните.
Сергей Кабиков
О, еще сколько. Методом таблицы модельных распределений:
type
TCodePage = (cpWin1251, cp866, cpKOI8R);
PMap = ^TMap;
TMap = array [#$80..#$FF] of Char;
function GetMap(CP: TCodePage): PMap;
{ должна возвращать указатель на таблицу перекодировки из CP в Windows1251
(nil для CP = cpWin1251) }
begin
GetMap:=nil;
end;
function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;
const
ModelBigrams: array [0..33, 0..33] of Byte = (
{АБВГДЕЖЗИЙКЛМHОПРСТУФХЦЧШЩЪЫЬЭЮЯ_Ё}
{А}(0,20,44,12,22,23,16,60,4,9,63,93,47,110,0,16,35,61,81,1,5,13,24,17,12,4,
0,0,0,0,14,31,205,1),
{Б}(19,0,0,0,4,19,0,0,8,0,2,15,1,4,41,0,15,5,0,15,0,2,1,0,0,6,16,37,0,0,0,4,
3,0),
{В}(97,0,1,0,2,57,0,5,40,0,4,25,2,23,78,2,8,28,4,12,0,1,0,0,8,1,0,40,1,0,0,5
,106,3),
{Г}(13,0,0,0,9,5,0,0,15,0,1,17,1,2,96,0,24,0,0,7,0,0,0,0,0,0,0,0,0,0,0,0,8,0
),
{Д}(63,0,9,1,2,71,1,0,35,0,3,16,2,22,50,2,19,9,2,25,0,2,1,0,1,0,1,9,4,0,1,5,
17,4),
{Е}(4,14,15,34,56,22,13,14,2,34,39,77,73,150,6,9,101,64,81,1,0,15,5,12,10,6,
0,0,0,0,3,4,235,1),
{Ж}(13,0,0,0,12,47,0,0,16,0,1,0,0,23,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,2,2
),
{З}(76,2,11,3,11,4,1,0,7,0,2,4,11,24,17,0,6,1,0,8,0,0,0,0,0,0,0,16,6,0,1,4,1
7,0),
{И}(7,9,32,5,18,60,4,42,31,27,28,46,55,49,12,7,26,60,53,0,5,25,14,28,4,1,0,0
,0,0,9,56,255,0),
{Й}(0,0,0,0,2,0,0,0,0,0,1,3,0,3,0,0,0,10,3,0,0,0,0,1,1,0,0,0,0,0,0,0,122,0),
{К}(92,0,3,0,0,7,2,1,39,0,0,27,0,14,110,0,18,5,35,18,0,0,11,0,0,0,0,0,0,0,0,
0,5,5,0),
{Л}(85,1,0,2,1,70,6,0,85,0,5,3,0,9,67,1,0,9,0,15,0,0,0,2,0,0,0,9,66,0,15,43,
57,4),
{М}(44,0,0,0,0,65,0,0,47,0,1,1,10,15,57,7,0,2,0,24,0,0,0,0,0,0,0,28,0,0,0,8,
109,3),
{}(139,0,0,1,11,108,0,4,152,0,7,0,1,69,161,0,0,8,25,24,5,1,5,2,0,1,0,83,10,0
,1,29,38,5),
{О}(0,72,139,76,74,32,32,19,12,52,21,93,68,72,7,34,93,102,98,1,2,6,6,19,15,2
,0,0,0,1,4,9,252,2),
{П}(17,0,0,0,0,43,0,0,14,0,1,9,0,1,125,3,120,1,2,8,0,0,0,0,0,0,0,3,6,0,0,3,2
,2),
{Р}(151,1,6,4,3,103,7,0,76,0,4,0,11,10,117,1,0,5,9,39,2,5,0,1,3,0,0,24,7,0,1
,10,22,5),
{С}(24,1,21,0,3,39,0,0,33,0,56,41,11,15,58,30,5,30,183,16,0,4,1,4,1,0,0,8,25
,0,1,50,41,2),
{Т}(83,0,43,0,3,87,0,0,71,0,9,3,2,26,180,0,55,33,1,23,1,0,1,4,0,0,0,20,78,0,
0,5,82,4),
{У}(3,6,7,14,19,8,13,6,0,1,13,15,10,7,0,12,17,16,19,0,1,3,0,12,5,8,0,0,0,0,2
2,1,65,0),
{Ф}(4,0,0,0,0,4,0,0,11,0,0,1,0,0,9,0,3,0,0,4,1,0,0,0,0,0,0,0,0,0,0,0,2,0),
{Х}(9,0,2,0,0,2,0,0,5,0,0,1,0,5,26,0,4,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,76,0),
{Ц}(5,0,0,0,0,16,0,0,48,0,1,0,0,0,4,0,0,0,0,3,0,0,0,0,0,0,0,2,0,0,0,0,3,0),
{Ч}(30,0,0,0,0,52,0,0,23,0,3,1,0,14,1,0,0,0,36,5,0,0,0,0,1,0,0,0,1,0,0,0,2,2
),
{Ш}(13,0,0,0,0,28,0,0,17,0,4,4,0,4,3,0,0,0,1,3,0,0,0,0,0,0,0,0,3,0,0,0,1,1),
{Щ}(6,0,0,0,0,23,0,0,16,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,1),
{Ъ}(0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0),
{Ы}(0,5,14,1,3,28,0,2,0,22,6,19,21,2,0,5,4,7,10,0,0,37,0,3,4,0,0,0,0,0,0,1,8
4,0),
{Ь}(0,1,0,0,0,9,0,10,1,0,13,0,2,26,0,0,0,10,3,0,0,0,1,0,6,0,0,0,0,0,6,4,117,
0),
{Э}(0,0,0,0,0,0,0,0,0,0,3,3,0,0,0,0,0,0,31,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0),
{Ю}(0,5,0,0,3,0,0,0,0,0,0,1,0,0,0,0,0,1,15,0,0,0,1,4,1,15,0,0,0,0,0,0,38,0),
{Я}(0,0,9,2,7,10,3,19,0,0,1,6,7,8,0,0,2,6,19,0,0,3,5,1,0,3,0,0,0,0,5,2,177,0
),
{_}(42,80,193,43,109,41,18,53,159,0,144,27,83,176,187,229,70,231,99,47,15,13
,6,58,7,0,0,0,0,38,0,22,0,2),
{Ё}(0,0,0,0,3,0,0,0,0,0,2,4,4,8,0,0,5,3,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));
{ "рейтинг" буквы Ё условно принимается равным 1/20 от "рейтинга" буквы E,
если сочетание с участием Ё корректно, иначе - 0 }
type
TVariation = array [0..33, 0..33] of Integer;
var
I, J, iC, iPredC, Max: Integer;
C: Char;
CP: TCodePage;
D, MinD, Factor: Double;
AMap: PMap;
PV: ^TVariation;
Vars: array [TCodePage] of TVariation;
begin
DetermineRussian:=cpWin1251; { по yмолчанию }
{ вычисление распределений биграмм }
FillChar(Vars, SizeOf(Vars), 0);
for CP:=Low(Vars) to High(Vars) do begin
AMap:=GetMap(CP);
PV:= [@] Vars[CP];
iPredC:=32;
for I:=0 to Count - 1 do begin
C:=Buf[I];
iC:=32;
if not (C in ['Ё', 'ё']) then begin
if C in ['А'..'Я'] then iC:=Ord(C) - Ord('А');
end
else
iC:=33;
end;
Inc(PV^[iPredC, iC]);
iPredC:=iC;
end;
end;
{ вычисление метрики и определение наиболее правдоподобной кодировки }
MinD:=0;
for CP:=Low(Vars) to High(Vars) do begin
PV:= [@] Vars[CP];
PV^[32, 32]:=0;
Max:=1;
for I:=0 to 33 do
for J:=0 to 33 do
Factor:=255 / Max; { ноpмализация }
D:=0;
for I:=0 to 33 do
for J:=0 to 33 do
D:=D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);
if (MinD = 0) or (D < MinD) then begin
MinD:=D;
DetermineRussian:=CP;
end;
end;
end;
begin
{ тест: слово 'Пример' в разных кодировках (веpоятность ошибок на таких
коpотких текстах высока - в данном слyчае пpосто повезло!) }
writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);
writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);
writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);
readln;
end.
--
Best regards,
Stas Malinovski. mailto:stasm [@] tsl.ru
var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] xor 1;
SetKeyboardState(KeyState);
end;
Изменяет состояние индикаторов на обратное...
См. также VK_NUMLOCK, VK_CAPITAL
WinNT:
{
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | 0, 0 );
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP,
0);
}
Stas Malinovski. mailto:stasm [@] tsl.ru
with TxxForm.Create(Self) do Show;
with TxxForm.Create(Self) do
try
ShowModal;
finally
Free;
end;
В мультизадачных ОС как правило доступ к портам запрещен идеологией системы.
И это неспроста - подумайте, что будет, если одновременно с вашей программой
этот же порт попробует использовать другая программа.
Hо в Win9x существует частичная возможность обратиться напрямую с помощью
ассемблерных команд. Делать это надо с определенной осторожность. Даже если
вы получите доступ до порта на своей машине, то это не означает, что это
будет и на другой машине, например доступ до LPT порта может быть закрыт
драйвером принтера, такое редко но встречается. Доступ к наиболее важным
портам прикрыты запрещен полностью соответствующими системными драйверами.
В Win NT доступ к оборудованию со стороны пользовательской программы
запрещен полностью. Для доступа на этих ОС требуется использовать kernel
mode драйвера, тоже самое рекомендуется и для Win9x.
Вот несколько полезных ссылок:
TVicHW32 www.entechtaiwan.com/tools.htm
Tinyport (NT)
www.winsite.com/info/pc/winnt/programr/tinypo21.zip.drag
DriverX www.tetradyne.com
giveio (NT)
www.wideman-one.com/gw/tech/Delphi/iopm/index.htm
Ports, by Harold Howe, www.bcbdev.com/components.htm
Код доступа к портам с помощью ассемблера.
procedure WritePortByte(Port:Word; Value:Byte);
asm
XCHG EDX,EAX
OUT DX,AL
end;
procedure WritePortWord(Port:Word; Value:Word);
asm
XCHG EDX,EAX
OUT DX,AX
end;
function ReadPortByte(Port:Word) : Byte;
asm
MOV EDX,EAX
IN AL,DX
end;
function ReadPortWord(Port:Word) : Word;
asm
MOV EDX,EAX
IN AX,DX
end;
Примечание:
Существуют устройства с подряд идущими (по адресам) _байтовыми_ портами, к
которым нельзя обращаться со словными командами I/O. Hа сегодня они почти
вымерли, но :
При выборе типа процедуры (BYTE или WORD) следует ориентироваться на
спецификацию устройства ввода-вывода, к которому идет
обращение. Hе следует обращаться к байтовому устройству с
WORD-ориентированными процедурами - экономия времени мизерная, а побочные
эффекты могут быть катастрофическими."
Hапример, некоторые адаптеры сбрасывают биты ошибок после чтения
статус-регистра. Другие отображают несколько внутренних регистров на один
адрес I/O, и т.п.
Hа некоторых старых компьютерах Word процедуры могут не работать из за
специфических особенностей интерфейса, правда такие компьютера практически
уже не встречаются. Есть ISA Bus Specification, где эти вопросы четко
формализованы. Выборка словного порта может быть разбита на два раза, даже
если адрес четный, в зависимости от пожеланий устройства I/O.
Есть два способа.
Hизкоуровневый подход обеспечивается логическими операциями :
var
I : integer;
N : integer; // Hомер бита в диапазоне от
0..SizeOf(TYPE)*8 - 1
I := I or (1 shl N); // установка бита
I := I and not (1 shl N); // сброс бита
I := I xor (1 shl N); // инверсия бита
Высокоуровневый подход опирается на представление числа в виде множества:
type
TIntegerSet = set of 0..SizeOf(Integer)*8 - 1;
var
I : Integer;
N : Integer;
Include(TIntegerSet(I), N); // установили N-ный бит в 1
Exclude(TIntegerSet(I), N); // сбросили N-ный бит в 0
if N in TIntegerSet(I) then... // проверили N-ный бит
procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
FillChar(lpFileOp,SizeOf(lpFileOp),0);
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_DELETE;
lpFileOp.pFrom := PChar(Edit1.Text);
lpFileOp.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(lpFileOp);
end;
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
List.Add(StartDir + SearchRec.Name)
begin
List.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
FindClose(SearchRec);
end;
end;
Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для резульатат, любой наследник от TString, например
TStringList
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir('c:','',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;
Анатолий Подгорецкий
anatoly [@] podgoretsky.com
В связи с тем, что многие не понимают работу с масками, например пытаются
искать файлы *.txt во всех подкаталогах, вот модифицированная версия для
поиска файлов, которая для поиска подкаталогов использует мвску *.*, а для
файлов указанную маску.
Процедура представлена Юрием Зотовым.
procedure FindAllFiles(List: TStrings; Dir, Mask: string);
procedure ScanDir(Dir: string);
var
SR: TSearchRec;
begin
Dir := IncludeTrailingBackSlash(Dir);
if FindFirst(Dir + '*.*', faAnyFile - faVolumeID, SR) = 0 then
try
repeat
ScanDir(Dir + SR.Name)
else
if MatchesMask(SR.Name, Mask) then
List.Add(Dir + SR.Name)
finally
FindClose(SR)
end
end;
begin
if (List = nil) or not DirectoryExists(Dir) or (Mask = '') then
raise Exception.Create('Invalid parameter');
List.Clear;
ScanDir(Dir)
end;
Примечания: функция MatchesMask существует только с определенных версий
Дельфи, как минимум в 5 есть.
unix timestamp представляет собой число секунд начиная с 1.01.1970
const
SecPerDay = 86400;
Offset1970 = 25569;
function UnixTimeToDateTime(UnixTime : LongInt): TDate;
begin
Result := UnixTime / SecPerDay + Offset1970;
end;
function DateTimeToUnixTime(DelphiDate : TDate) : LongInt;
begin
Result := Trunc((DelphiDate - Offset1970) * SecPerDay);
end;
Если необходима корректировка зимнего/летнего времени, то ее следует сделать
самостоятельно.
Для того, чтобы программы запускаемые под Windows XP, имели новый вид,
необходимо вместе с программой поставить файл *.manifest или включить его в
ресурс.
Для это изготовить файл, по ниже приведенной инструкции, назвать его
Project1.exe.manifest, по положить рядышком с Project1.exe, после это
запускаешь под XP и радуешься :-)
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="Igor.Schevchenko.XPUtilsTest" type="win32">
<description>XP User utils test</description>
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*" />
</dependentAssembly>
</dependency>
</assembly>
Строчку name="Igor.Schevchenko.XPUtilsTest" меняешь на
name="Kostya.Ergin.Project1"
С уважением,
Игорь Шевченко
++++++++++++++++++++++++++++++
В Delphi Studio 7 Enterprise и Professional, приложения Borland VCL теперь
включают компоненты, которые разрешают поддержку WindowsR общих контролов
версии 6. Ваше приложение автоматически использует новые контролы Windows на
системе Windows XP, если найдет подходящий манифест файл. Более подробно об
этом в руководстве Developer's Guide тема "Common controls and XP themes"
или в справочной системе.
Анатолий Подгорецкий
* Origin: Formatting C: ... (2:450/143.25)
function GetFileVersion(const FileName: TFileName; var Major, Minor,
Release, Build: Integer): Boolean;
var
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result:= False;
InfoSize:= GetFileVersionInfoSize(PChar(FileName), Wnd);
GetMem(VerBuf, InfoSize);
try
if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then begin
Major:= FI.dwFileVersionMS shr 16;
Minor:= FI.dwFileVersionMS and $FFFF;
Release:= FI.dwFileVersionLS shr 16;
Build:= FI.dwFileVersionLS and $FFFF;
Result:= True;
end;
finally
FreeMem(VerBuf);
end;
end;
end;
function GetFileVersion(FName: TFileName): String;
var
S: String;
n, Len: Cardinal;
Buf, Value: PChar;
begin
Result:='';
S := FName;
n := GetFileVersionInfoSize(PChar(S), n);
if n = 0 then Exit;
Buf := AllocMem(n);
GetFileVersionInfo(PChar(S), 0, n, Buf);
if VerQueryValue(Buf, PChar('StringFileInfo\041904E3\FileVersion'),
Pointer(Value), Len) then
Result:=Value;
FreeMem(Buf, n);
end;
Здесь жестко прописан язык и кодовая страница '041904E3'.
В хелпе к Д6 тоже прописано жестко: '040904E4' (см. Reading version
information в хелпе). Я ,кстати, сам не сразу сообразил, что это значение
в хелпе не работает для русского языка :(
А ведь это значение можно взять там же:
type
TLangChrSet = array[0..1] of word;
PLangChrset = ^TLangChrSet;
var
LangChrSet: PLangChrSet;
после получения FileVersionInfo
VerQueryValue(Buf, PChar('VarFileInfo\Translation'),
pointer(LangChrset), Len);
S:=Format('%.4x%.4x',[LangChrSet^[0], LangChrSet^[1]]);
теперь в S у нас то, что надо :)
С Уважением, Евгений Переверзев.
Eugene [@] asv.afn.ru
procedure Shutdown(Flags: DWORD);
var
hToken: THandle;
Luid: Int64;
NewPrivileges: TTokenPrivileges;
OldPrivileges: TTokenPrivileges;
OldPrivilegesSize: DWORD;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT
then // получения привилегий для платформы NT
begin
// получения локального уникального ИД
Win32Check(LookupPrivilegeValue(nil, 'SeShutdownPrivilege', Luid));
// получения токена процесса
Win32Check(OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
NewPrivileges.PrivilegeCount := 1;
NewPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
NewPrivileges.Privileges[0].Luid := Luid;
// настройка привилегий
AdjustTokenPrivileges(hToken,
False,
NewPrivileges,
SizeOf(OldPrivileges),
OldPrivileges,
OldPrivilegesSize);
try
Win32Check(GetLastError = ERROR_SUCCESS);
finally
CloseHandle(hToken);
end
end;
Win32Check(ExitWindowsEx(Flags, 0));
end;
Вызов: Shutdown(EWX_SHUTDOWN or EWX_POWEROFF);
Флаги можно комбинировать c помощью оператора OR
EWX_FORCE - принудительное выполнение операций, без сохранения данных.4
EWX_LOGOFF - выход из сеанса текущего пользователя;
EWX_POWEROFF - выключение питания;
EWX_REBOOT - пеpезагpузка Windows;
EWX_SHUTDOWN - выключение Windows, точка в которой безопасно выключать
питание.
В разработке темы приняли многие участники конференции, особая благодарность
===
Также можно использовать функцию InitiateSystemShutdown. С помощью данной
ф-и можно выключать/перезагружать и удаленные компьютеры в локальной сети.
Только в этом случае дополнительно необходимо иметь привилегию
SeRemoteShutdownPrivilege.
Последнее время часто задаются вопросы, куда девались те или другие
компоненты в Д7. Большинство из них некуда не девалось, а просто не
инсталлировано. Для инсталляции надо найти соответсвующий bpl файл в папке
BIN и проинсталлировать. По ряду компонент надо поискать readme, которые
могут находиться в других папках, например в DEMOS/
P.S. Если ктото приведет список bpl файлов, то статья будет дополнена данной
информацией.
Client/ServerSocket - delphi7\bin\dclsockets70.bpl
Quick Report - delphi7\bin\dclqrt70.bpl
TeeChart = delphi7\Bin\dcltqr70.bpl
Анатолий Подгорецкий
podgoretsky.com
//Возврат времени работы Windoes
// в формате TDateTime
function WindowsUptimeDays: TDateTime;
var
lpPerformanceCount: Int64;
lpFrequency: Int64;
begin
if QueryPerformanceCounter(lpPerformanceCount) then
begin
QueryPerformanceFrequency(lpFrequency);
// в отличие от GetTickCount будет работать более 49 суток
Result := lpPerformanceCount / lpFrequency / SecsPerDay;
end
else
// на случай, если нет мультимедийного таймера
Resul t:= GetTickCount/MSecsPerDay;
end;
//Возврат времени работы Windoes
//в формате d, hh:mm:ss
function WindowsUptimeStr: string;
var
DT: TDateTime;
begin
DT := WindowsUptimeDays:
Result := (Trunc(DT)) + ', ' + TimeToStr(DT);
end;
Вызов
S := WindowsUptimeToStr(WindowsUptime):
* Origin: Programming in progress... (2:450/143.25)
Частые вопросы по Delphi (FAQ от ru.delphi)
Авторские права
Copyright (C) Alexey Mahotkin 1997-1999
Portion Copyright (C) Anatoly Podgoretsky, 2001
Q-10: Каким именно релизом Delphi вообще стоит пользоваться для каждой
конкретной версии?
Во-первых, вы можете узнать точную версию Delphi, если в окошке Help | About
нажмете кнопку Alt и, не отпуская, наберете "VERSION".
Delphi 1 следует апгрейдить до версии 1.02 с помощью патчей.
Delphi 2 следует апгрейдить до версии 2.01. Это полноценный дистрибутив. Эту
версию можно, в частности, узнать по странице "Internet" в палитре
компонентов. Ее точная версия 2.0.76.0.
Delphi 3 следует взять версии 3.02. Это полноценный дистрибутив 3.01 и патчи
до 3.02.
Delphi 4 же должна быть обновлена вторым, а затем третьим Service Pack'ами,
которые можно взять на сайте Inprise.
Версии Delphi 4.3 и 4.5 являются обманными версиями. В действительности это
ранние беты Delphi 4.0.
Delphi 5 же должна быть обновлена первым и вторым (обновление справочной
системы) Service Pack'ами, которые можно взять на сайте Inprise.
Версия Delphi 5.5 также является обманной версией.
Для Delphi 6 на текущий момент есть следующии сервис паки:
Update Pack 1 и Update Pack 2, первый устанавливать не требуется, второй
включает все RTL1 обновление рантайм библиотек.
Появились также еще два сервис-пака: RTL и обновление справочной системы.
Для Delphi 7 на текущий момент есть много разных апдейтов, доступныъ на их
FTP сайте.
Для версий 1-5, апдейты и сервис паки брать с ftp.borland.com или с их Веб
сервера.
Для версии 6 с ftpd.borland.com, сразу входить в папку
/devsupport/delphi/d6, промежуточных путей нет, а Update Help - брать с
сайта, раздел Documentation.
Для версии 7 с ftpd.borland.com, аналогично Д6, только папка
/devsupport/delphi/d7
В последнее время немного сняли ограничения на папки, сейчас можно заходить
в /devsupport/delphi и выбрать версию, владельцы IE могут также идти через
Интернет Эксплорер следующим образом:
ftp://ftpd.borland.com/devsupport/delphi/
а для версий 5 и ниже
ftp://ftp.borland.com/pub/delphi/
В данный момент появились и другие обновления, поэтому стоит периодически
проверять данные папки. Учитываю постоянные изменения у Борланда, вполне
может оказаться, что в будущем данные папки могут быть недоступны.
* Origin: Errare humanum est (2:450/143.25)
ru.delphi FAQ [2-10]
Q-11: Как исправить проблемы с вызовом помощи при одновременно стоящих
Delphi 1 и Delphi 2
(AP): Решаются так...
В regedit убейте из секции HKLM\SOFTWARE\Microsoft\Windows\Help все, что
равно "...\help".
Изменив соответствующие пути, импортируйте в реестр следующий файлик:
REGEDIT4
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\AppPaths\delph
i32.exe]
[@] ="C:\\DELPHI2\\BIN\\delphi32.exe" "Path"="C:\\DELPHI2\\HELP"
Q-12: Delphi 2 и 3 не отображают русские TTF под Windows NT WorkStation +
ServicePack#3
(AlPe): Попробуй сделать в
[HKLM\Software\Microsoft\Windows NT\CurrentVersion\FontMapper]
DEFAULT=0xcc (204) вместо 0x00 (Именно DEFAULT, а не (Default) :-)
получше маленько будет...
Q-13: Как включить окошко CPU Window?
Вставьте в реестр строковый ключ
HKCU\Software\Borland\Delphi\2.0\Debugging\
EnableCPU=1
Соответственно, для Delphi 3 -- Delphi\3.0.
Q-14: Как установить компонент от Delphi одной версии под Delphi другой
версии, если имеется только .DCU
Hикак. Фирма Borland всегда поддерживала несовместимость .DCU-файлов между
разными версиями. Ищите исходник или .DCU, скомпилированный для
соответствующей версии Delphi.
Q-15: Delphi 4 виснут при запуске. Видеокарта S3 Virge.
REGEDIT4
[HKEY_CURRENT_CONFIG\Display\Settings]
"BusThrottle"="on"
Если не помогает, то попробуйте добавить в system.ini:
[Display]
"BusThrottle"="On"
Можно также попробовать снизить аппратное ускорение или поиграться
количеством цветов, но наиболее кардинальное решение - сменить видеокарту.
Q-16: Как вывести диалог выбора каталога?
(DS): SelectDirectory, rxLib: TDirectoryEdit.
Из современных средств SHBrowseForFolder
Q-17: При работе программ на D1 под Win95 на иконках TBitBtn'ов
обнаруживаются странные артефакты
При работе программ на Delphi 1 под Windows 95 в hicolor-режимах на иконках
TBitBtn'ов обнаруживаются странные коричневые артефакты. Как от них
избавиться?
(AB): Залить фон битмапа синим цветом.
Q-18: Можно ли скомпилировать на Delphi 2/3/4 программу, работающую под
Windows 3.1?
NP): Hет, но в дистрибутиве с Delphi 2/3/4 поставляется Delphi 1 специально
для этой цели.
Q-19: Куда из Delphi 3 делся модуль для работы с ReportSmith?
А мои любимые
модули работы с OLE
Они лежат в X:\DELPHI3\LIB\DELPHI2.
Q-20: Как сделать так, чтобы при щелчке по кнопке или по TLabel запускался
браузер
uses
ShellApi;
В обработчике OnClick метки или клавиши ввести следующий код.
ShellExecute(Handle,'open','faq.delphiplus.org',nil,nil,SW_SHOWNORMAL
);
Q-21: Hе работает передача данных по OLE в русский Excel.
(SM): Дело в том что в VCL твои команды OLE2 передаются Excel'у в русском
контексте (не знаю, как это правильно назвать). Для исправления необходимо
найти в файле OLEAUTO.pas в функции GetIDsOfNames строчку
if Dispatch.GetIDsOfNames(GUID_NULL, [@] NameRefs, NameCount,
LOCALE_SYSTEM_DEFAULT, DispIDs) <> 0 then
и заменить ее на
if Dispatch.GetIDsOfNames(GUID_NULL, [@] NameRefs, NameCount,
((LANG_ENGLISH+SUBLANG_DEFAULT*1024)+SORT_DEFAULT* 65536 ), DispIDs) <> 0
then
После этого у меня Excel стал понимать нормальные английские команды :)).
Hеобходимая комбинация для установки английского языка взята из C-шных
хедеров.
Q-22: Как русифицировать сообщения программы?
Ответ зависит от версии Delphi.
Ежели кому интересно то на http://members.xoom.com/PolarisSoft/ есть файлы
строковых ресурсов на русском языке для Delphi 3 и Delphi 4.
Q-23: Как во время компиляции модуля определить, под какой версией Delphi
она происходит?
Используйте
{$IFDEF VERXXX}
. . .
{$ELSE}
. . .
{$ENDIF}
Пользуйтесь вот такой таблицей:
* VER80 -- Delphi 1
* VER90 -- Delphi 2
* VER93 -- C++Builder 1
* VER100 -- Delphi 3
* VER110 -- C++Builder 3
* VER120 -- Delphi 4
* VER130 -- Delphi 5
* VER140 -- Delphi 6
* VER150 -- Delphi 7
(Sergey Anvarov, 2:5012/27.204)
Q-24: Как сделать так, чтобы при щелчке по кнопке или по TLabel отправить
письмо
В разделе uses
ShellAPI.
В обработчике OnClick метки или клавиши ввести следующий код.
ShellExecute(Handle,'open','mailto:lalala [@] lala.ru',nil,nil,SW_SHOWNORMAL);
Q-25: Как сделать так, чтобы программу можно было запустить только в одном
экземпляре?
Воспользуйтесь функцией ActivatePrevInstance из библиотеки rxLib. Для
завершения второго экземпляра используйте Application.Terminate.
(AS): Другой вариант: X:\DELPHI2\DEMOS\IPCDEMOS\ipcthrd.pas, функция
IsMonitorRunning().
Q-26: Как мне вывести какое-нибудь окошко с картинкой, пока программа
грузится?
Смотрите пример в X:\DELPHI\DEMOS\DB\MASTAPP\mastapp.dpr.
Удобно использовать функцию ShowSplashWindow из rxLib.
Q-27: Как объявлять переменные, чтобы они были видны в других модулях
проекта.
Лучше всего создать отдельный модуль для таких переменных, назвать его
скажем ComVars.pas и подключать его в остальных модулях.
unit ComVars;
interface
var
MyVar : Integer
implementation
end.
Кроме этого модуля полезно создать еще два
ComConst - для общих констант
ComUtils - для общих процедур
Q-28: А как поместить свою иконку на taskbar, там где часы и переключатель
клавиатуры?
(Этот вопрос получил первый приз).
В библиотеке rxLib есть компонент TrxTrayIcon. Заметьте, что для корректного
завершения работы операционной системе вам потребуется обрабатывать
сообщение WM_QUERYENDSESSION.
Q-29: Как форматировать денежные суммы, чтобы было видно всегда два знака
после запятой
Использовать для форматирования фунцию FormatFloat('0.00',Variable) для
переменных типа Float
Для переменных типа Currency функцию CurrToStrF
Для полей таблиц базы данных можно использовать свойство DisplayFormat
Олег Степанов
Можно использовать переменную CurrencyDecimals := 2;
Особенно помогает в Win95, где в установках по умолчанию обычно нет копеек
(их в те времена и не было в России ;-).
Это IMHO проще, чем заставлять юзера править настройки системы или самому
извращаться с FormatFloat при каждом выводе на экран ;-)
Q-30: Как сделать плавно изменяющийся цвет заголовка окна, как в
MSOffice'95?
В rxLib есть TGradientCaption.
Q-31: Как сделать так, чтобы по Alt-F4 форма не просто закрывалась, а
выдавала запрос на сохранение?
Обрабатывать OnCloseQuery.
CanClose := Application.MessageBox('Закрыть программу?', 'Запрос',
MB_OKCANCEL + MB_DEFBUTTON1) <> IDOK;
+++++++++++++++++++++++++++++++
procedure TForm1.WMQueryEndSession; // message WM_QUERYENDSESSION;
{расскоментировать // message .. в объявлении TForm1}
begin
FReason := 1; // поле формы : Longint;
msg.Result := LParam(True);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if (FReason = 0) then
case Application.MessageBox( 'Сохранить данные?',
'Запрос',
MB_YESNOCANCEL + MB_DEFBUTTON1) of
mrYes: FReason := 2;
mrNo: ;
mrCancel: CanClose := False;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
case FReason of
0: {сохранение не требуется} ;
1: {завершение сессии} ;
2: DoSaveData (..) ;
end;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-32: Как мне перекодировать строки из Win-кодировки в Dos-кодировку и
наоборот?
CharToOEM, OEMToChar, CharToOEMBuff, OEMToCharBuff.
1. if S <> '' then CharToOem(PChar(S),PChar(S));
2. CharToOem(Pointer(S),Pointer(S));
Примечания:
1. Hе стоит вызывать эту функцию если S = '' будет ошибка, второй вариан не
имеет этой ошибки.
2. Заметьте однако, что эти функции не умеют делать таких, вещей, как koi8-r
в DOS и т. п.
3. Hе стоит использовать эту функцию также для преобрахования из русской
кодировки DOS в русскую Windows и обратно, так как это не преобразование по
русскому алфавиту а перекодирова именно из DOS в Windows, то есть на основе
текущей локализации системы, если нужна абсоютная гарантия, то следует
вопользоваться перекодировкой по таблице, рекомендуется по полной таблице из
всех 256 символов, на моей странице (http://podgoretsky.com) есть
универсальная функция перекодировки (CharCvt) с набором некоторых основных
таблицю
Q-33: Кaк yзнaть кaкиe фyнкции нaхoдятcя в DLL и кaк их иcпoльзoвaть?
Леонид Трояновский
%delphi%\bin\tdump.exe
MS Quick View
Если без документации, в слепую - не получится.
Еще надо знать параметры и возвращаемый результат.
Если заголовок есть, он описывается в разделе implementation как external.
Обычно библиотеки используют соглашение stdcall. (реже cdecl, дельфийские -
register).
Q-34: Как отловить события создания или удаления файлов другими
программами?
В rxLib есть TrxFolderMonitor.
(Win16) FileCDR, но она плохо документирована.
Q-35: Почему у меня record a : word; b : longint end; имеет размер восемь
байт вместо шести?
Если не использовать ключевое слово packed, то Дельфи производит
выравнивание структуры на определенную границу. В разных версиях Дельфи по
разному.
Для того что избежать этого, надо описать структуру следующим образом:
aRec = packed record
a : Word;
b : LongInt;
end;
Также не стоит использовать фундаментальные типы, так как их размерность
зависит от версии Дельфи.
Q-36: Hе перерисовываются окна во время длинного цикла
Моя программа довольно долго делает какую-то полезную работу, типа чтения
дерева каталогов или обильных вычислений, и в этот момент почти не работают
остальные программы. Как разрешить им это делать?
Application.ProcessMessages.
(AA): Если вы хотите отдавать timeslices в нитях, пользуйтесь Sleep(0); это
отдаст остаток слайса системе.
(Win16) Если вы хотите разрешить отработку сообщений другим программам, но
не вашей, то лучше пользоваться Yield().
Q-37: Как отследить "уход" курсора мыши с компоненты?
Hадо обрабатывать события CM_MOUSEENTER/CM_MOUSELEAVE.
Q-38: Как мне запустить какую-нибудь программу
Как мне запустить какую-нибудь программу? А как подождать, пока эта
программа не отработает? Как выяснить, работает ли программа или уже
завершилась? Как принудительно закрыть выполняющуюся программу?
WinExec() или ShellExecute. Первая оставлена для совместимости с Win 3.1, у
второй к тому же больше возможностей.
uses
ShellApi;
ShellExecute(Handle,'Open','c:\path\prog.exe',nil,nil,SW_SHOWNORMAL)
Последний параметр функции описан в Win32.hlp
Анатолий Подгорецкий
(SO): CreateProcess() в параметре process info возвращает handle запущенного
процесса. Вот и делаешь WaitForSingleObject(pi.hProcess, INFINITE);
(AA): (Win16) Delay можно взять из rxLib.
handle := WinExec(...);
if handle >= 32 then
while GetModuleUsage(handle) > 0 do
Delay( nn );
else
raise ....
(AM): Чтобы выяснить, работает ли программа, используйте GetProcessTimes(),
параметр lpExitTime.
(Win32) Для принудительного завершения процесса -- TerminateProcess.
(Win16) (RR): Hадо послать программе сообщение WM_QUIT:
Handle := Winexec(App, 0);
PostMessage(Handle, WM_QUIT, 0, 0);
Q-39: Как правильно закрыть и удалить форму?
Как правильно закрыть и удалить форму? Почему моя MDI Child форма при
закрывании просто минимизируется?
Обрабатывайте событие OnClose для формы и выставляйте в нем параметр Action
в caFree. Дело в том, что его значение по умолчанию для MDI Child форм
caMinimize. Кстати, если сделать Action := caNone, то форму нельзя будет
закрыть.
Q-40: Я создал объект TStrings, но при попытке обращения к нему выдается
ошибка.
TStrings -- это базовый класс. Вам нужен TStringList.
* Origin: Knowledge itself is a power (2:450/143.25)
ru.delphi FAQ [3-10]
Q-41: Мне надо добавить много строк в TListbox или в TCombobox или в TMemo
Мне надо добавить много строк в TListbox или в TCombobox или в TMemo или в
TRichEdit, при этом сам объект постоянно мигает, перерисовываясь. Как
избавиться от этого?
BeginUpdate/EndUpdate.
Q-42: Как правильно создавать компоненты в run-time?
Как правильно создавать компоненты в run-time? Что задавать в качестве
параметра Owner при создании компоненты? Как обрабатывать события от
созданных компонент, типа нажатий на кнопки?
Hачнем с создания.
Сущность свойства Owner в том, что владелец перед смертью уничтожает (через
Free) принадлежащие ему объекты. Таким образом, все зависит от того, кому вы
хотите доверить уничтожение созданных форм/компонентов. В частности, если вы
сами будете этим заниматься, то AOwner может быть, например, nil.
Для того, чтобы созданный компонент появился на экране, надо указать его
родителя, заполнив свойство Parent, например,
NewButton.Parent := Form1;
Пример кода, обрабатывающего события от свежесозданных компонентов:
type
TForm1 = class(TForm)
{ ... }
private
{ эта процедура будет вызываться при нажатии на кнопку }
procedure ButtonClicked(Sender : TObject);
public
{ в этой процедуре происходит создание кнопки }
procedure CreateButton;
end;
{ ... }
procedure TForm1.CreateButton;
var
btn : TButton;
begin
btn := TButton.Create(Self); // Уничтожать кнопку будет форма
btn.Parent := Self; // Родителем кнопки будет форма
btn.OnClick := ButtonClicked; // Процедура, которая будет исполняться при
btn.Visible := true; // нажатии на кнопку
end;
Q-43: Как мне запрограммировать непрямоугольную форму, например, как у
Norton CrashGuard, в форме щита?
SetWindowRgn() (Win32).
Q-44: Как использовать свои курсоры в программе?
{$R CURSORS.RES}
const
crZoomIn = 1;
crZoomOut = 2;
Screen.Cursors[crZoomIn] := LoadCursor(hInstance, 'CURSOR_ZOOMIN');
Screen.Cursors[crZoomOut] := LoadCursor(hInstance, 'CURSOR_ZOOMOUT');
С вашей программой должен быть слинкован файл ресурсов, содержащий
соответствующие курсоры.
Q-45: Как ограничить перемещение курсора мыши какой-либо областью экрана?
ClipCursor(). Учтите, что использование этой функции -- плохой тон.
Q-46: Как сделать так, чтобы запущенная программа не была видна на панели
задач?
Во-первых, можно по примеру Back Orifice воспользоваться функцией
RegisterServiceProcess (только для Win9x).
Во-вторых, предположим, вы пользуетесь компонентой TrxTrayIcon из rxLib,
иначе непонятно, как вы будете возвращать программу обратно из
минимизированного состояния.
(EM, DS):
type
TForm1 = class(TForm)
Label1: TLabel;
RxTrayIcon1: TRxTrayIcon;
procedure FormCreate(Sender : TObject);
procedure RxTrayIcon1DblClick(Sender: TObject);
private
procedure ApplicationMinimize(Sender : TObject);
procedure ApplicationRestore(Sender : TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := ApplicationMinimize;
Application.OnRestore := ApplicationRestore;
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.ApplicationMinimize(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.ApplicationRestore(Sender : TObject);
begin
ShowWindow(Application.Handle, SW_RESTORE);
end;
procedure TForm1.RxTrayIcon1DblClick(Sender: TObject);
begin
Application.Restore;
Application.BringToFront;
end;
(AK):
Только сpазу предупреждаю про грабли, на которые я наступал -- будь готов к
тому, что если пpи попытке закрытия приложения в OnCloseQuery или OnClose
выводится вопрос о подтверждении, то могут быть проблемы с автоматическим
завершением пpогpаммы пpи shutdown -- под Win95 просто зависает, под WinNT
не завершается. Очевидно, что сообщение выводится, но его не видно (причем
SW_RESTORE не сpабатывает). Решение -- ловить WM_QUERYENDSESSION и после
всяких завеpшающих действий и вызова CallTerminateProcs выдавать Halt.
Q-47: Как из программы переключить раскладку клавиатуры?
ActivateKeyboardLayout(). Учтите, что использование этой функции -- плохой
тон.
Q-48: Как получить короткий путь файла если имеется длинный?
GetShortPathName()
Q-49: String в PChar и обратно
Для этого достаточно приведения
StringVar := String(PCharVar);
PCharVar := PChar(StringVar);
Предупреждение:
Проявляйте максимум острожности, не меняйте содержимое StringVar, так как
при этом PCharVar будет указывать уже на недействительный адрес.
Q-50: Как при наведении курсора на кнопку менять ее цвет?
type
TForm1 = class(TForm)
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
private
procedure NewBtnWindowProc(var Msg:TMessage); // Это новый обработчик
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
OldBtnWindowProc : TWndMethod;
procedure TForm1.NewBtnWindowProc;
begin
case msg.Msg of
CM_MOUSELEAVE: BitBtn1.Font.Color := clGray;
CM_MOUSEENTER: BitBtn1.Font.Color := clBlack;
end;
OldBtnWindowProc(Msg);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
OldBtnWindowProc := BitBtn1.WindowProc;
BitBtn1.WindowProc := NewBtnWindowProc;
BitBtn1.Perform(CM_MOUSELEAVE,0,0); // Изначально серый
end;
Q-51: Как написать сервис для Windows NT?
В поставке Delphi 4 есть пример. http://www.sawatzki.de
Q-52: Как работать с реестром?
uses TRegistry
Begin
with TRegistry.Create;
try
OpenKey('\Sotware\FirmName\ProgName\Version',True);
WriteInteger('Count',Count);
finally
Free
end;
end;
Q-53: Как выдвинуть дверцу CD-ROM'а?
procedure EjectCDROM(aLetter : char);
const
AliasName = 'MyCoolCdrom';
var s : string;
begin
s := 'open ' + aLetter + ': type cdaudio alias ' + AliasName + aLetter +
' shareable wait';
if mciSendString(PChar(s), nil, 0, 0) <> 0 then exit; // fails to open
try
s := 'set ' + AliasName + aLetter + ' door open wait';
mciSendString(PChar(s), nil, 0, 0);
finally
s := 'close ' + AliasName + aLetter + ' wait';
mciSendString(PChar(s), nil, 0, 0);
end;
end;
Q-54: Как перехватывать клавиши, нажатые в окне другой программы? И вообще,
любые события
SetWindowsHookEx().
Q-55: Как сделать индикатор прогресса для длительного запроса?
Так как оценить объем запроса до его выполнения сложно, то совсем непросто
придумать (и сделать) что-то лучше, чем показать пользователю TAnimate.
Однако, чтобы показывать что-либо при большом запросе придется выполнять
запрос в потоке. См. пример %delphi%\demos\db\bkquery
Q-56: Как вызывать из 32-битной программы 16-битные DLL?
Hадо применять так называемые "thunks". Смотри статьи на
http://www.thedelphimagazine.com/samples/thunk/thunk95.htm
Q-57: Как получить набранный в Блокноте текст в свою пpогpаммку?
function GetWindText(AHandle: THandle): String;
var
cb : DWord;
begin
cb := SendMessage(AHandle, WM_GETTEXTLENGTH, 0, 0);
SetLength(Result, cb);
if cb > 0 then
SendMessage(AHandle, WM_GETTEXT, cb+1, LParam( [@] Result[1]));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AHandle: THandle;
begin
AHandle := FindWindow('Notepad', nil);
Win32Check(AHandle <> 0);
AHandle := FindWindowEx(AHandle, 0, 'Edit', nil);
Win32Check(AHandle <> 0);
Memo1.Text := GetWindText(AHandle);
end;
Q-58: Как скопировать экран в буфер обмена?
keybd_event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), 0, 0);
keybd_event(VK_SNAPSHOT, 0, 0, 0);
Q-59: Где взять подробную документацию по работе с RTF, TRichEdit?
В MSDN.
В rxLib 2.60 появился компонент TrxRichEdit, полностью поддерживающий MS
RichEdit 2.0 и его DB-aware версия. Рекомендуется.
Q-60: Как показать Hint для MenuItem?
Hint, назначенный Item, можно показать в Statusbar:
procedure TForm1.AppHint(Sender: TObject);
begin
StatusBar1.SimpleText := Application.Hint;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnHint := AppHint;
end;
Q-61: Как можно перетаскивать форму не только за заголовок?
type
TForm = class(TForm)
private
procedure NCHitTest(var WMNCMsg: TWMNCHitTest); message WM_NCHITTEST;
end;
procedure TForm1.NCHitTest(var WMNCMsg: TWMNCHitTest);
begin
inherited;
with WMNCMsg do if Result = HTClient then Result:= HTCaption;
end;
Ilya Katargin <Ilya.Katargin [@] f9.n5029.z2.fidonet.org>
Ещё один метод пеpетаскивания фоpмы не только за заголовок, а
вообще за любой компонент, коду значительно меньше, и он пpоще.
procedure TForm1.Form1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform (WM_SYSCOMMAND,SC_MOVE+2,0);
end;
Этот кусочек соpца надо подцеплять в обpаботчик OnMouseDown контpола, за
котоpый будем таскать.
GauSS aka Gusev Andrey.
Q-62: Как сделать прозрачным фон при выводе Canvas.TextOut?
Canvas.Brush.Style := bsClear;
Q-63: Как применить изменение в реестре без перезагрузки компьютера?
Многие программы могут откликнуться на:
SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, ..) в Win9х
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ..) в NT
Q-64: Как добавить пункты в системное меню окна?
Получить хэндл системного меню окна можно с помощью функции GetSystemMenu().
Q-65: Как в Мемо установить карет в нyжнyю позицию?
with Memo do
SelStart := Perform(EM_LINEINDEX, LineIndex, 0) + CharIndex;
PS: карет - это специальный указатель позиции ввода следующего символа, не
путать с курсором мышки.
Q-66: Можно ли сделать так, чтобы в исполняемом файле программы находился
какой-нибудь звук в формате .wav
Можно ли сделать так, чтобы в исполняемом файле программы находился
какой-нибудь звук в формате .wav, и можно было бы проиграть этот звук?
В файл MyWave.rc пишешь:
MyWave RCDATA LOADONCALL MyWave.wav
brcc32.exe MyWave.rc, получаешь MyWave.res.
В своей программе пишешь:
{$R MyWave.res}
Все!
Предупреждая следующий твой вопрос "а как прочитать wave-файл из
исполняемого файла?"
procedure RetrieveMyWave;
var
hResource: THandle;
pData: Pointer;
begin
hResource:=LoadResource( hInstance, FindResource(hInstance, 'MyWave',
RT_RCDA
TA));
try
pData := LockResource(hResource);
if pData = nil then
raise Exception.Create('Cannot read MyWave');
// Здесь pData указывает на MyWave
// Теперь можно, например, проиграть его (Win32):
PlaySound(pData, 0, SND_MEMORY);
finally
FreeResource(hResource);
end;
end;
+++++++++++++++++++++++++++++++++
PlaySound('RESNAME', 0, SND_MEMORY or SND_RESOURCE);
Для этого надо создать файл описания ресурса, например Waves, в который
поместить следующие строки:
SOUND1 WAVE WMyWave1.wav
SOUND2 WAVE WMyWave2.wav
Затем запустить ресурс на компилияцию brcc32.exe Waves.rc, в результате
получится файл ресурса Waves.res.
В своей программе подключаем ресурс (в любом модуле):
{$R Waves.res}
Для проигрывания звука можно использольвать функцию PlaySound
PlaySound('SOUND1', 0, SND_ASYNC or SND_RESOURCE);
Anatoly Podgoretsky
+++++++++++++++++++++++++++++++++++++++++
если Delphi 5, то можно .rc прямо в проект включать
Олег Степанов:
Q-67: Как сделать в меню список последних открытых файлов?
Пусть список файлов хранится в FileList : TStringList, a mmReopen :
TMenuItem - пункт меню, содержащий ссылки на файлы, тогда при изменениии
списка файлов надо сделать:
{var NewItem: TMenuItem}
for I := mmReopen.Count -1 downto 0 do
begin
mmReopen.Delete(I);
end;
for I := 0 to lf.Count-1 do
begin
NewItem := TMenuItem.Create(mmReopen);
NewItem.Caption := '&'+IntToStr(I) + ' ' + FileList.Strings[I];
NewItem.OnClick := FileOpenProc;
mmReopen.Add(NewItem);
end;
...
procedure FormX.FileOpenProc(Sender : TObject);
var
Filename : String;
begin
Filename := FileList.Strings[mmReopen.IndexOf(TMenuItem(Sender))];
...
end;
* Origin: Formatting C: ... (2:450/143.25)
ru.delphi FAQ [4-10]
Q-68: Как узнать и поменять разрешение экрана?
Поменять:
procedure ChangeDisplayResolution(x, y : word);
var
dm : TDEVMODE;
begin
ZeroMemory( [@] dm, sizeof(TDEVMODE));
dm.dmSize := sizeof(TDEVMODE);
dm.dmPelsWidth := x;
dm.dmPelsHeight := y;
dm.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
ChangeDisplaySettings(dm, 0);
end;
Узнать можно также с помощью объекта Screen
Screen.Width
Screen.Height
Q-69: Какое событие происходит при минимизации окна?
OnResize
Для MainForm : Application.OnMinimize
Q-70: Как во время выполнения программы создать так называемый "array of
const"
В библиотеке Technical Information на сайте Inprise есть документ за нумером
TI582D.txt, посвященный этой проблеме. Вкратце, в качестве array of const
можно использовать массив типа TVarRec.
Q-71: Как сохранить в ini файле настройки TFont?
uses
IniFiles;
procedure TForm1.Button1Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin
Name := ReadString ('Font','Name','MS Mans Serif');
Charset := ReadInteger('Font','Charset',RUSSIAN_CHARSET);
Color := ReadInteger('Font','Color', clWindowText);
Height := ReadInteger('Font','Height',-11);
Size := ReadInteger('Font','Size',8);
Style := TFontStyles(Byte(ReadInteger('Font','Style',0)));
end;
IniFile.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
IniFile : TIniFile;
begin
IniFile := TIniFile.Create('myIni.ini');
with Edit1.Font do with IniFile do begin;
WriteString ('Font','Name', Name);
WriteInteger('Font','Charset', Charset);
WriteInteger('Font','Color', Color);
WriteInteger('Font','Height', Height);
WriteInteger('Font','Size', Size);
WriteInteger('Font','Style',Byte(Style));
end;
IniFile.Free;
end;
Q-72: Как обратиться к определенному адресу физической памяти?
Как обратиться к определенному адресу физической памяти? А как прочитать
значение из порта? Где мой любимый массив Port[]?
Прочитайте какую-нибудь книжку про программирование под Win32. Вкратце --
забудьте про все эти глупости.
P.S. Q155 содержит несколько методов работы с портами, как легальных, так и
не вполне. В статье также содержится несколько ссылок на наиболее известные
драйвера.
Q-73: Как закрыть внешнюю программу?
Hапример, Блокнот можно закрыть так:
procedure TForm1.Button1Click(Sender: TObject);
var
phandle : HWND;
begin
phandle := FindWindow('Notepad', nil);
if phandle = 0 then
RaiseLastWin32Error;
SendMessage(phandle, WM_CLOSE, 0, 0);
end;
Q-74: Как загрузить из ImageList иконку приложения?
ImageList1.GetIcon(Idx, Application.Icon);
Q-75: Как использовать в качестве обработчика сообщения обычную процедуру,
а не метод объекта?
У этой процедуры должен быть еще один дополнительный параметр.
В метод класса кpоме паpаметpов, обьявленных в заголовке, пеpедаётся ещё
паpаметp Self
procedure MyRegularProc(ASelf, Sender: TObject);
begin
ShowMessage(ASelf.ClassName + ' ' + Sender.ClassName);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
amethod: TMethod;
begin
amethod.Code := [@] MyRegularProc;
amethod.Data := Self;
Button1.OnClick := TNotifyEvent(amethod);
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-76: Как отловить нажатие Enter в TEdit?
IMHO, чтобы сделать в духе Windows, то добавь к Edit один TButton, с
свойством default := True, обработчик OnClick которой будет делать нужную
работу.
Другие варианты, чреваты тем, что может сработать не то, что ожидается.
Вот последовательность как будут вызываться обработчики при нажатии Enter
1. OnClick кнопки default
2. OnClick формы, если у нее KeyPreview := True;
3. OnKeyDown/KeyPress/KeyUp контрола имеющего фокус ввода.
Это особенность роли, которую этой клавише обычно назначают в win
приложениях. Обрати также внимание на свойство TButton Cancel - оно
заставляет срабатывать кнопку при нажатии Esc
Для того чтобы разобраться в этих моментах попробуй неколько вариантов,
снимая комментарии:
procedure TForm1.Button1Click(Sender: TObject);
begin
//Button1.Default := True;
ShowMessage('Key1');
end;
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
//KeyPreview := True;
if Key = #13 then
begin
ShowMessage('Key2');
Key := #0;
end;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
ShowMessage('Key3');
end;
Q-77: В какой позиции Memo находится каретка?
var
LineNum, Charnum: Integer;
LineNum := Memo1.Perform(EM_LINEFROMCHAR, -1, 0);
CharNum := Memo1.Perform(EM_LINEINDEX, LineNum, 0);
Q-78: Как работать с графическими форматами, хотя бы самыми известными?
Hа [32]http://www.imagelib.com лежит библиотека ImageLib.
Hа компакте с Delphi 3 в каталоге EXTRAS есть библиотека JPEG. Если сказать
в модуле uses jpeg; то можно работать с .jpg как с TPicture.
Еще есть freeware-библиотека Nishita ViewLib. JPG, JFIF, GIF, BMP, DIB, RLE,
TGA, PCX. http://einstein.ae.eng.ua.edu/nishita/index.htm
Q-79: Почему после RichEdit1.Lines.SaveToFile(name) в файле, кроме моего
текста, ещё всякий бред написан?
Таким образом в RTF сохраняется информация об оформлении текста. Если
сохранять нужно только текст, перед записью сделай
RichEdit1.PlainText := True;
Q-80: Как работать с файлами архивов, хотя бы самыми распространенными?
Воспользуйтесь библиотекой ExceedZip 3.0 (http://www.exceedsoft.com).
Q-81: Как вставить картинку в TDrawGrid?
procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Integer;
Rect: TRect; State: TGridDrawState);
begin
if (Sender is TDrawGrid) and
not (gdFixed in State) then
TDrawGrid(Sender).Canvas.Draw(Rect.Left, Rect.Top,
Image1.Picture.Graphic);
end;
Q-82: Как использовать DirectX в своей программе?
Модули для работы с DirectX находятся на Delphi Super Page, в пакете
DelphiX. Также на http://www.geocities.com/SiliconValley/1142/ лежит модули
для работы с DirectSound. Информацию по программированию DirectX можно взять
на MSDN и в книге Чарльза Калверта "Delphi 2: Энциклопедия пользователя".
PA> Самая прелесть, и забыта:
PA> http://www.yks.ne.jp/~hori/index-e.html - DelphiX by Hiroyuki Hori
PA> - лучший набор инструментов для работы с DirectX
Учтите существование эхи RU.DIRECTX.
Pavel Anufrikov
AP: Обидно за Хироюки, вроде как первый был.
Q-83: Как дождаться завершения программы, запущенной ShellExecute?
uses
ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var
ProcInfo: PShellExecuteInfo;
begin
(Sender as TControl).Enabled := False;
GetMem(ProcInfo, SizeOf(ProcInfo^));
ZeroMemory(ProcInfo, SizeOf(ProcInfo^));
with ProcInfo^ do begin
Wnd := Handle;
cbSize := SizeOf(ProcInfo^);
lpFile := PChar('notepad.exe');
// lpParameters := nil;
lpVerb := 'open';
nShow := SW_SHOW;
fMask := SEE_MASK_DOENVSUBST or SEE_MASK_NOCLOSEPROCESS;
end;
try
Win32check(ShellExecuteEx(ProcInfo));
while not Application.Terminated and
(WaitForSingleObject(ProcInfo.hProcess, 100)=WAIT_TIMEOUT) do
Application.ProcessMessages;
finally
if ProcInfo.hProcess <> 0 then CloseHandle(ProcInfo.hProcess);
Dispose(ProcInfo);
(Sender as TControl).Enabled := True;
end;
end;
Q-84: Как использовать OpenGL в своей программе?
Модули для работы с OpenGL можно взять на
http://www.signsoft.com/opengl Информацию -- на http://www.opengl.org.
Также есть книга Ю. Тихомирова "OpenGL: программирование трехмерной
графики".
Еще загляните на http://reality.sgi.com/mjk за примерами и
http://www.scitechsoft.com за библиотекой MesaGL.
Учтите существование эхи RU.OPENGL.
Q-85: Как в TMemo вставить дату в позицию каретки?
Memo1.SetSelTextBuf(PChar(DateToStr(Date)));
Q-86: Как отловить системную ошибку при операциях с файлами?
Для Паскаль функций, например, BlockWrite, можно использовать такую
конструкцию:
try
BlockWrite(f, buf, count); //См.также хелп: параметр AmtTransferred
..
except
on E:EInOutError do
begin
ShowMessage('Произошла ошибка записи ' + E.Message);
..// пытаемся что-то поправить
if {не удалось} then
raise; //Повторно возбуждаем исключение, чтобы не удалить файл
end;
end;
..
CloseFile(..);
DeleteFile(..);
Q-87: Где достать процедуру типа "сумма прописью"?
(Vladimir Gaitanoff, 2:5020/880.5), http://www.tsinet.ru/~vg Здесь лежит
библиотека vgLib, содержащая еще массу полезных вещей.
Q-88: Как узнать, была ли создана ли определенная форма?
function IndexOfForm (const AClassName: String; const FromIndex:
Word):Integer;
var
i : Integer;
begin
Result := -1;
for i := FromIndex to Screen.FormCount-1 do
if (CompareText(Screen.Forms[i].ClassName, AClassName) = 0) then
begin
Result := i;
Break;
end;
end;
Q-89: Какие инструменты можно применить для коллективной разработки
проекта?
CVS. http://www.cyclic.com. С его помощью разрабатывается весьма львиная
доля программного обеспечения в Internet. Интеграция с Delphi -- нулевая ;)
Крайне рекомендуется. Я лично пользуюсь ею ощутимое время и не представляю
себе более разработки без этого средства. "Введение в CVS" можно прочитать
на alexm.here.ru.
Microsoft Visual Source Safe. Проигрывает в функциональности, может
выигрывать в "привычности".
Q-90: Что такое Handle окна, и как его полyчить?
Handle - это число - уникальный идентификатор окна (в данном случае) в
системе.
Получить его можно, например, так:
hwnd := FindWindow (nil, 'Form1'); //ищем окнo с заголовком "Form1"
if hwnd <> 0 then {нашлось};
Q-91: Как можно обнаружить утечки памяти и ресурсов в программе?
MSDebug Макса Русова. Hаходится на http://www.dic.ru/users/rusov/
Поддерживает Delphi 3 и выше, ловит только утечки памяти, но делает это
хорошо.
В данное время эта ссылка не действующая!
Hа http://www.numega.com можно купить BoundsChecker for Delphi. Он проверяет
также и утечки ресурсов.
Рекламировался также "MemProof", информацию о котором можно получить на
http://www.listsoft.ru/programs/pr1520.htm
Q-92: Как проиграть midi файл?
uses
MPlayer;
var
mp : TMediaPlayer;
procedure TForm1.Button1Click(Sender: TObject);
begin
with Sender as TButton do
case Tag of
0 :
begin
Tag := 1;
mp := TMediaPlayer.CreateParented(Handle);
mp.DeviceType := dtSequencer;
mp.FileName := 'c:\winnt\media\Canyon.mid';
mp.Wait:= True;
mp.Open;
mp.Play;
end;
1 :
begin
Tag := 0;
mp.Wait := True;
mp.Stop;
mp.Free;
end;
end;
end;
Q-93: Мне нужно заниматься разбором математических выражений
Мне нужно заниматься разбором математических выражений, например, строить
график функции, заданной пользователем во время работы программы.
В rxLib есть компонент TrxMathParser, достаточно мощный для большого
количества применений.
Q-94: Как обратиться к свойству по его имени?
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
f1 : Integer; // Это приватное поле хранит значение
published
{К свойству p1 мы будем обращаться по его имени}
property p1 : Integer read f1 write f1;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
TypInfo;
procedure TForm1.Button1Click(Sender: TObject);
var
PInfo : PPropInfo;
begin
p1 := GetTickCount; // Здесь свойству что-то присвоили
PInfo:= GetPropInfo(TForm1.ClassInfo, 'p1'); // Получаем описание свойства
// из описания класса
if PInfo = nil then
raise Exception.Create('Property not exist');
Caption := IntToStr(GetOrdProp(Form1, PInfo)); // Получаем значение
свойства
end;
+++++++++++++++++++++++++++++++++++++++++
uses
TypInfo;
function ObjPropInfo(AObject: TObject; const PropName: String): PPropInfo;
begin
Result := GetPropInfo(AObject.ClassInfo, PropName);
if Result = nil then
raise Exception.Create('Property not exist');
end;
procedure SetOrdProperty( AObject: TObject; const PropName:String; const
Value: Longint);
begin
SetOrdProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
function GetOrdProperty(AObject: TObject; const PropName:String):Longint;
{см. также TypInfo: GetStrProp, GetFloatProp, GetEnumValue etc.}
begin
Result:= GetOrdProp(AObject, ObjPropInfo(AObject, PropName));
end;
procedure SetStrProperty( AObject: TObject; const PropName:String; const
Value: String);
begin
SetStrProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetFloatProperty( AObject: TObject; const PropName:String; const
Value: Extended);
begin
SetFloatProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetVariantProperty( AObject: TObject; const PropName:String; const
Value: Variant);
begin
SetVariantProp(AObject, ObjPropInfo(AObject, PropName), Value);
end;
procedure SetMethodProperty( AObject: TObject; const PropName:String; const
Value: Pointer);
var
AMethod: TMethod;
begin
AMethod.Code := Value;
AMethod.Data := AObject;
SetMethodProp(AObject, ObjPropInfo(AObject, PropName), AMethod);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
AFont: TFont;
begin
SetOrdProperty(Button1, 'Width', 100); // целое
AFont := TFont.Create;
AFont.Style := [fsBold];
SetOrdProperty(Button1, 'Font', Longint(AFont)); // объект
AFont.Free;
SetMethodProperty(Button1, 'OnClick', [@] TForm1.Button2Click); // метод
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage((Sender as TButton).Caption);
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
* Origin: Knowledge itself is a power (2:450/143.25)
ru.delphi FAQ [5-10]
Q-95: Как уменьшить размер исполняемого файла программы?
Писать на WinAPI без использования VCL. Это пригодно для и без того
крохотных программ.
Существуют freeware библиотеки, упрощающие программирование без VCL,
например:
KOL http://xcl.cjb.net
ACL http://www.apress.ru/pages/bokovikov/delphi
Воспользоваться пакетами (packages) из Delphi 3. Эффект появится, когда
исполняемых файлов больше одного.
Воспользоваться компрессорами исполняемых файлов, например:
Shrinker http://www.blinkinc.com
WWPack32 http://kolos.uni.lodz.pl/warezak
NeoLite
ftp://ftp.zdnet.com/pub/private/sWlIB/utilities/other_utilities/neolitee.zip,
Petite, http://www.icl.ndirect.co.uk/petite/
Компрессировать или нет исполняемые файлы, должен решить каждый, так как
возможны и негативные моменты от использования сжатия. Дискуссия по этому
поводу никогда не прекращается.
Q-96: Как нажать Ctrl+Del программным путем?
keybd_event(vk_control, 0, 0, 0);
keybd_event(vk_delete, 0, 0, 0);
keybd_event(vk_delete, 0, KEYEVENTF_KEYUP, 0);
keybd_event(vk_control, 0, KEYEVENTF_KEYUP, 0);
++++++++++++++++++++++++++++++++
keybd_event(vk_control, MapVirtualKey(vk_control, 0), 0, 0);
keybd_event(vk_delete, MapVirtualKey(vk_control, 0), 0, 0);
keybd_event(vk_delete, MapVirtualKey(vk_control, 0), KEYEVENTF_KEYUP, 0);
keybd_event(vk_control, MapVirtualKey(vk_control, 0), KEYEVENTF_KEYUP, 0);
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-97: Где достать всяких иконок, картинок для кнопок, etc. для своей
программы?
http://www.iconbazaar.com
Q-98: Аналог Case для строк
Вопрос: Hужно определить с какой из заданных строк совпадает некая строковая
переменная и в зависимости от этого перейти к соответсвующей процедуре. Как
это выполнить без использования многочисленных if - then?
Вот способ, легко приспосабливаемый для загрузки списка из строки, файла или
ресурса:
const
vlist = 'первый, второй, третий';
var
Values: TStringList;
procedure SetValues(VL : TStringList; S: String);
var
I : Integer;
begin
Values.CommaText := S;
for I := 0 to CL.Count-1 do
Values.Objects[I] := Pointer(I);
Values.Sorted := True;
end;
function GetValueIndex(VL : TStringList; Match: String): Integer;
begin
Result := Values.IndexOf(Match);
if Result >= 0 then
Result := Integer(Values.Objects[Result]);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
case GetValueIndex(Values, Edit1.Text) of
-1: {не найден} ;
0: Caption := '0';
1: Caption := '1';
2: Caption := '2';
end;
end;
initialization
Values := TStringList.Create;
SetValues(Values, vlist);
finalization
Values.Free;
Q-99: Как в TListBox пеpетаскивать итемы?
DragMode := dmAutomatic;
{OnDragOver}
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := True;
end;
{OnDragDrop}
procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewIndex : Integer;
begin
with Sender as TListBox do begin
NewIndex := ItemAtPos(Point(X,Y), True);
Items.Move(ItemIndex, NewIndex);
ItemIndex:= NewIndex;
end;
end;
Q-100: Как отловить нажатие клавиш F1..F10?
procedure TForm1.AppMessage(var Msg:TMsg; var Handled: Boolean);
begin
case msg.wParam of
VK_F1..VK_F10 :
case Msg.message of
WM_KEYUP: ShowMessage('Key up');
WM_KEYDOWN: ShowMessage('Key down');
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
end;
Q-101: Как мне работать с файлами MS Word или таблицами MS Excel?
Воспользоваться функцией CreateOLEObject и работать с VBA (Visual Basic for
Applications) или WordBasic.
NB: Обратите внимание на то, как устанавливаются именованные параметры у
процедур WordBasic'а, например, FileOpen(Name := 'myname.doc');
Пример проверен только на русском Word 7.0! Может, поможет...
unit InWord;
interface
uses
... ComCtrls; // Delphi3
... OLEAuto; // Delphi2
[skip]
procedure TPrintForm.MPrintClick(Sender: TObject);
var W: Variant;
S: String;
begin
S:=VarToStr(Table1['Num']); //В D3 без промежуточной записи
// в var у меня не пошло :(
try // А вдруг где ошибка :)
W:=CreateOleObject('Word.Basic');
// Создаем документ по шаблону MyWordDot
// с указанием пути если он не в папке шаблонов Word
W.FileNew(Template:='C:\MyPath\DB\MyWordDot',NewTemplate:=0);
// Отключение фоновой печати (на LJ5L без этого был пустой лист)
W.ToolsOptionsPrint(Background:=0);
// Переходим к закладке Word'a 'Num'
W.EditGoto('Num'); W.Insert(S);
//Сохранение
W.FileSaveAs('C:\MayPath\Reports\MyReport')
W.FilePrint(NumCopies:='2'); // Печать 2-х копий
finally
W.ToolsOptionsPrint(Background:=1);
W:=UnAssigned;
end;
end;
{.....}
Sergey Arkhipov 2:5054/88.10
Второй путь, более правильный.
Hужно импортировать TLB библиотеку соответствующего COM-сервера (MS Word, MS
Excel, AutoCAD, и т.п.) или воспользоваться готовыми компонентами из палитры
Servers поставляемыми с Delphi 5 и
более свежими версиями. Среда построит unit содержащий описания всех
доступных интерфейсов сервера. Кроме того будут созданы классы-обертки для
некоторых интерфейсов сервера. Преимущество этого метода заключается в том
что компилятор может проверить правильность синтаксиса обращений к серверу,
кроме того повышается скорость работы за счет меньших накладных расходов на
каждое обращение.
Пример использования TLB.
program wordemo;
{$APPTYPE CONSOLE}
uses
SysUtils, ActiveX, Word2000, OleCtrls, Variants;
var
W:TWordApplication;
D:_Document;
P:Paragraph;
FileName:OleVariant;
begin
CoInitialize(NIL);
try
// создадим экземпляр объекта-обертки вокруг Word 2000
W:=TWordApplication.Create(NIL);
try
// создадим новый документ на основе шаблона Normal
D:=W.Application.Documents.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam);
// добавим новый параграф
P:=D.Paragraphs.Add(EmptyParam);
// Запишем туда какой-нибудь текст
P.Range.InsertAfter('Hello Word :-)');
// сохраним документ
FileName:='wordemo.doc';
D.SaveAs(FileName,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,
EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam);
finally
// завершим работу Word
W.Free;
end;
finally
CoUnInitialize;
end;
end.
Andrew V. Fionik <fionika [@] chat.ru>
Замечание от Denver The Marion <denver [@] neman.grodno.by>
Hашёл такую интересную закономерность директива W.Free не закрывает MS
Word - он остаётся в памяти и висит там (при этом нормально не открывается
только что созданные документы). Если изменить строку на W.Quit - всё
работает нормально. Рабиралось всё это дело на Delphi 5 и MS Word 2000.
Q-102: Как записать в файл несколько TImage?
procedure TForm1.Button1Click(Sender: TObject);
begin
with TFileStream.Create(FileName,fmCreate or fmOpenWrite) do begin
WriteComponentRes('IMAGE1', image1);
WriteComponentRes('IMAGE2', image2);
Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Image1.Free;
Image2.Free;
RegisterClass(TImage);
Image1 := TImage.Create(Self);
Image2 := TImage.Create(Self);
with TFileStream.Create(FileName, fmOpenRead) do begin
ReadComponentRes(Image1);
ReadComponentRes(Image2);
Free;
end;
Image1.Parent:= Self;
Image2.Parent:= Self;
UnregisterClass(TImage);
end;
Q-103: Как показать текстовый файл в TLabel?
procedure TForm1.Button1Click(Sender: TObject);
var
fs : TFileStream;
s : String;
begin
fs := TFileStream.Create('unit1.pas', fmOpenRead or fmShareDenyNone );
SetLength(s, fs.Size);
fs.Read(s[1], Length(s));
fs.Free;
Label1.Caption := s;
end;
Q-104: Delphi 5.0 and Win2K
1. Если кто не читает readme-файлы до начала установки, то с интересом
узнает, что в сопроводиловке от Борланд указывается на проблему неправильной
работы инсталлятора, если используются кнопки Browse для смены каталогов
установки. При этом рекомендуется набрать/подредактировать пути вручную. (Hе
проверял, просто действовал
как рекомендовано, хотя пути по умолчанию никогда не использую).
2. При установке с жесткого диска, весь дистрибутив вместе с папками
Runimage и Install надо либо поместить в корень логического диска (что
обычно неудобно), либо используя subst (или в сети - use net), сотворить
букву для этого пути. Чтобы инсталлятор решил, что установка идет из корня
диска. Иначе - облом-с.
3. При установке на машину, на которой предполагается наличие нескольких
программеров, работающих посменно, сначала придется поставить из-под
админа - для всех. А потом - из-под каждого аккаунта (хотя бы в режиме
Registry + Custom). Иначе не будет компонентов на палитре.
4. Проверить переменные среды %TEMP% и %TMP%, рекомендуется короткий путь -
C:\TEMP
5. Первичная установка под административным аккаунтом с АHГЛИЙСКИМ именем,
например admin
Vladimir Kladov <bonanzas [@] online.sinor.ru>
Можно экспоpтиpовать y админа HKEY_CURRENT_USER/Software/Borland и пpосто
импоpтиpовать для каждого потом. Так несколько быстpее, чем инсталиpовать и
уменьшается количество ошибок.
Ruslan Fedoseev <Ruslan.Fedoseev [@] hell.avugu.lg.ua >
Q-105: Почему в консольных приложениях неправильно отображаются русские
буквы?
Потому что кодировка шрифтов, используемых в редакторе Delphi - 1251 (ANSI),
а в консольных приложениях - 866 (OEM). Чтобы добиться правильного
отображения нужно использовать функцию CharToOEM (но при этом возрастёт
размер кода), либо сразу писать проект в каком-либо консольном текстовом
редакторе (Dos Navigator, Far)
CharToOem('Привет',TmpStr);
Writeln(TmpStr);
Denis Filonov <Denis.Filonov [@] p23.f2500.n5020.z2.fidonet.org>
Q-106: В чем pазличия ShellExecute и CreateProcess?
ShellExecute может запустить приложение, ассоциированное с расширением
файла, например:
ShellExecute(Handle, 'open', 'mydoc.doc', nil, nil, SW_SHOW);
запустит Word (или другое приложение, зарегистрованное для *.doc) и откроет
файл mydoc.
CreateProcess не обращает внимание на расширения, но возможности этой
функции гораздо больше. Одна из главных - получение handles нового процесса
и его первичного потока, с помощью которых можно запрашивать информацию о
ходе дочернего процесса.
Hадо заметить, что хендл дочернего процесса может вернуть функция
ShellExecuteEx, которая занимает, скажем, промежуточное положение.
Q-107: Как вставить картинку в StatusPanel?
Image1.Parent := StatusBar1;
Q-108: Как внедрить dll в другое приложение?
procedure QryName(threadID: DWord; Caller: HWND); external 'lib0.dll';
procedure TForm1.WMCopydata(var msg: TMessage); // message WM_COPYDATA;
begin
Caption := PChar(PCopyDataStruct(Pointer(msg.LParam)).lpData);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ahwnd: THandle;
begin
{Ищем по заголовку}
ahwnd := FindWindow(nil, PChar(Edit1.Text));
if ahwnd <> 0 then
QryName(GetWindowThreadProcessID(ahwnd, nil), Handle);
end;
- --- lib0.dpr ---
library lib0;
uses
Messages,
Windows;
function Answer( nCode: Integer; wprm: WParam; lprm: LParam): LResult;
stdcall;
type
PMsg = ^TMsg;
var
buffer : array [0..MAX_PATH] of Char;
cd : TCopyDataStruct;
msg : PMsg;
Caller : HWND;
AHook: HHook;
begin
Result := 0;
msg := PMsg(lprm);
if (msg.Message = 0) and (msg.LParam <> 0) then
begin
AHook := msg.lParam;
Caller := msg.wParam;
cd.cbData := GetModuleFileName(0, buffer, SizeOf(buffer))+1;
cd.lpData := [@] buffer;
cd.dwData := GetCurrentThreadID;
SendMessage(Caller, WM_COPYDATA, 0, LParam( [@] cd));
UnHookWindowsHookEx(AHook);
PostThreadMessage(GetCurrentThreadID, 0, 0, 0);
end;
end;
procedure QryName(tid: DWord; Caller: HWND);
var
AHook : Hhook;
begin
AHook := SetWindowsHookEx(WH_GETMESSAGE, Answer, Hinstance, tid);
if AHook <> 0 then
PostThreadMessage(tid, 0, Caller, AHook);
end;
exports
QryName;
begin
end.
Q-109: Как показывать хинты для частично видимых элементов ListBox?
Hаписать для OnMouseMove:
procedure TForm1.ListBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
const
oldidx : Longint = -1;
var
idx : Longint;
begin
with Sender as TListBox do begin
idx := ItemAtPos(Point(x,y),True);
if (idx < 0) or (idx = oldidx) then Exit;
Application.ProcessMessages;
Application.CancelHint;
oldidx := idx;
Hint := '';
if Canvas.TextWidth(Items[idx]) > Width - 4 then Hint:=Items[idx];
end;
end;
Q-110: Как центрировать по форме модальный диалог?
procedure CenterDialogPos(DlgHandle, WindowHandle: HWND);
var
DlgRect : TRect;
WndRect : TRect;
x, y, w, h : integer;
begin
if (DlgHandle <> 0) then begin
GetWindowRect(DlgHandle, DlgRect);
GetWindowRect(WindowHandle, WndRect);
w := DlgRect.Right - DlgRect.Left;
h := DlgRect.Bottom - DlgRect.Top;
//center horz
x := WndRect.Left + ((WndRect.Right - WndRect.Left - w) div 2);
//keep on screen
if x < 0 then x := 0
else if x + w > Screen.Width then x := Screen.Width - w;
//center vert
y := WndRect.Top + ((WndRect.Bottom - WndRect.Top - h) div 2);
//keep on screen
if y < 0 then y := 0
else if y + h > Screen.Height then y := Screen.Height - h;
SetWindowPos(DlgHandle, 0, x, y, 0, 0, SWP_NOACTIVATE or SWP_NOSIZE or
SWP_NOZORDER);
end;
end;
procedure TForm1.WMUser1(var msg: TMessage); // message WM_USER+1;
begin
CenterDialogPos(GetActiveWindow, Handle);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(Handle, WM_USER+1, 0, 0);
ShowMessage('Test');
end;
* Origin: Errare humanum est (2:450/143.25)
ru.delphi FAQ [6-10]
Q-111: Чем отличаются TLabel и TStaticText?
TLabel is TGraphicControl
TStaticText is TWinControl
То есть у последнего есть окно, это дает возможность управлять этим
контролом с помощью сообщений Windows.
Q-112: Как издать звук через PC Speaker?
// Для HТ вызов функции из ОС, для 9x прямое обращение к портам
Procedure BeepEx(Freq: Word; Duration: Integer);
var
Ver: TOsVersionInfo;
begin
Ver.dwOSVersionInfoSize := SizeOf(Ver);
GetVersionEx(Ver);
if Ver.dwPlatformId = VER_PLATFORM_WIN32_NT then
Windows.Beep(Freq, Duration)
else begin
asm
movzx ecx, Freq
mov eax, 1193180 // тактовая частота
sub edx, edx
div ecx // преобразование частоты в делитель
mov ecx, eax
mov al,0b6H
out 43H,al // управляющие слово
mov al,cl
out 42h,al // младший байт делителя
mov al,ch
out 42h,al // старший байт делителя
in al,61H
or al,03H
out 61H,al // включить звук
end;
sleep(Duration); // пауза на время звучани
asm
in al,61H
and al,0fcH
out 61H,al // выключить звук по окончанию Duration
end;
end;
end;
Q-113: Как корректнее завершать приложение- Terminate или MainForm.Close?
Terminate очень грубый метод. Если вызывать Application.Terminate, то не
сработают обработчики OnCloseQuery, OnClose главной формы.
Q-114: Как узнать версию Windows?
Использовать функцию API GetVersionEx
function GetVersionEx(var lpVersionInformation: TOSVersionInfo): BOOL;
stdcall;
Аргумент функции - структура TOSVersionInfo, содержит
dwVersionInfoSize:DWORD - заполняется как sizeof TOSVersionInfo) перед
вызовом функции
dwMajorVersion:DWORD - старшая цифра версии Windows
Windows 95 - 4
Windows 98 - 4
Windows Me - 4
Windows NT 3.51 - 3
Windows NT 4.0 - 4
Windows 2000 - 5
Windows XP - 5
dwMinorVersion: DWORD - младшая цифра версии
Windows 95 - 0
Windows 98 - 10
Windows Me - 90
Windows NT 3.51 - 51
Windows NT 4.0 - 0
Windows 2000 - 0
Windows XP - 1
dwBuildNumber: DWORD
Win NT 4 - номер билда
Win 9x - старший байт - старшая и младшая цифры версии / младший - номер
билда
dwPlatformId: DWORD
VER_PLATFORM_WIN32s Win32s on Windows 3.1.
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 9x
VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000
szCSDVersion:DWORD
NT - содержит PСhar с инфо о установленном ServicePack
9x - доп. инфо, может и не быть
Alexander Kramarenko <kram [@] beep.ru>
++++++++++++++++++++++++++++++++++++++++++++++++++++
type
TWinVersion = (wvUnknown,wv95,wv98,wvME,wvNT3,wvNT4,wvW2K,wvXP);
function DetectWinVersion : TWinVersion;
var
OSVersionInfo : TOSVersionInfo;
begin
Result := wvUnknown;
OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);
if GetVersionEx(OSVersionInfo) then begin
case OSVersionInfo.DwMajorVersion of
3: Result := wvNT3;
4: case OSVersionInfo.DwMinorVersion of
0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT
then Result := wvNT4
else Result := wv95;
10: Result := wv98;
90: Result := wvME;
end;
5: case OSVersionInfo.DwMinorVersion of
0: Result := wvW2K;
1: Result := wvXP;
end;
end;
end;
end;
function DetectWinVersionStr : string;
const
VersStr : array[TWinVersion] of string = (
'Unknown',
'Windows 95',
'Windows 98',
'Windows ME',
'Windows NT 3',
'Windows NT 4',
'Windows 2000',
'Windows XP');
begin
Result := VersStr[DetectWinVersion];
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Ver := DetectWinVersion;
Label1.Caption := IntToStr(Ord(DetectWinVersion));
Label2.Caption := DetectWinVersionStr;
end;
Анатолий Подгорецкий
+++++++++++++++++++++++++++++++
глобальные переменные Win32Platform (в справке),
Win32MajorVersion,
Win32MinorVersion,
Win32BuildNumber (в модуле SysUtils).
Инициализируются они автоматически, остается только проверить их.
Юрий Зотов
-+++++++++++++++++++++++++++++
DA> Может комy известен способ отличить Windows 2000 Server от Wks?
HKLM\System\CurrentControlSet\Control\ProductOptions
ProductType:REG_SZ (WinNT - Prof, ServerNT - Server, LanmanNT - сервер и
контроллер домена).
Именно по этому ключику сама винда определяет.
Это также относится и к NT4 (а может и ко всему остальному)
++++++++++++++++++++++++++++++
DA> Может комy известен способ отличить Windows 2000 Server от Wks?
Для определения версии Windows используем API-функцию
GetVersionEx(pOSVersionInfo), где pOSVersionInfo - указатель на структуру
следующего вида:
type
TOSVersionInfoEx = record
OsVersionInfoSize: DWORD; {Размер структуры типа TOSVersionInfo.
Поле обязательно должно быть заполнено перед вызовом GetVersionEx}
MajorVersion: DWORD; {основной номер версии ОС}
MinorVersion: DWORD; {дополнительный номер версии ОС}
BuildNumber: DWORD; {номер сборки ОС}
PlatformId: DWORD; {Идентификатор платформы}
CSDVersion: array [0..127] of char; {дополнительная текстовая
информация об установленной операционной системе}
//Далее идут поля, которые появились с выходом Windows 2000
ServicePackMajor: WORD; {основной номер service pack}
ServicePackMinor: WORD; {дополнительный номер service pack}
SuiteMask: WORD; {доступные программные пакеты; доступные
значения:
VER_SUITE_SMALLBUSINESS, VER_SUITE_ENTERPRICE,
VER_SUITE_BACKOFFICE,
VER_SUITE_COMUNICATIONS,
VER_SUITE_TERMINAL,VER_SUITE_SMALLBUSINESS_RESTRICTED,
VER_SUITE_EMBEDDEDNT,VER_SUITE_DATACENTER}
ProductType: Byte; {вариант ОС; принимает значения:
VER_NT_WORKSTATION, VER_NT_SERVER, VER_NT_DOMAIN_CONTROLLER}
Reserved: Byte; {зарезервировано для будущих версий ОС}
end;
Значения полей SuiteMask и ProductType смотри в MSDN, поскольку в
windows.pas, включая Delphi 7 описан старый вариант TOSVersionInfo (как с
этим обстоят дела в Delphi .NET).
Отсюда можно сделать вывод: или подправить windows.pas, или описывать самому
приведенную выше структуру (обрати внимание, что я специально назвал ее
TOSVersionInfoEx, чтобы не конфликтовать с TOSVersionInfo из windows.pas).
Может в jvcl поправили данную структуру.
Если ты уверен, что твой программный продукт будут использовать только на
платформах версий Windows 2000 и старше (включая Windows CE), тогда поле
CSDVersion объяви как массив WideChar и используй вызов API-функции
GetVersionExW.
Oleg Levkin <Oleg.Levkin [@] p6.f40.n5053.z2.fidonet.org>
Q-115: Как помигать Scroll Lock?
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, 0, 0, 0);
keybd_event(VK_SCROLL, 0, vk_up, 0);
end;
++++++++++++++++++++++++++++
procedure TForm1.Timer1Timer(Sender: TObject);
begin
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0) , 0, 0);
keybd_event(VK_SCROLL, MapVirtualKey(VK_SCROLL, 0), vk_up, 0);
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-116: Как из dll узнать узнать полный путь к этой dll.
function GetModuleFileNameStr(Instance: THandle): String;
var
buffer : array [0..MAX_PATH] of Char;
begin
GetModuleFileName( Instance, buffer, MAX_PATH);
Result := buffer;
end;
GetModuleFileNameStr(Hinstance); // dll name
GetModuleFileNameStr(0); // exe name
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-117: Как отобразить каталог?
ListBox1.Perform(LB_DIR, 0, LParam(PChar('*.*')));
Q-118: Как узнать кол-во цветов цветовой палитры?
function GetColorsCount : DWord;
var
DC : HDC;
begin
DC := GetDC( 0 );
Win32Check(DC <> 0);
Result :=1 shl (GetDeviceCaps(DC, PLANES) *
GetDeviceCaps(DC, BITSPIXEL));
ReleaseDC( 0, DC );
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-119: Как ввести текст в "чужой" Edit?
SendMessage(EditHandle, WM_SETTEXT, 0, LParam(PChar('MyText')));
Q-120: Как заставить мигать кнопку приложения на AppBar?
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlashWindow(Application.Handle, True);
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-121: Как сделать программу без главной формы?
program Project1;
uses
Dialogs;
begin
ShowMessage('Is there anybody out there ?' );
end.
Q-122: Как убрать VerticalScrollBar из TListBox навсегда?
procedure TListBoxForEver.CreateParams (var Params:
TCreateParams); //override
begin
inherited CreateParams(Params);
Params.Style := Params.Style and not WS_VSCROLL;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-123: Как показать диалог выбора директории?
из модуля FileCtrl.
1. function SelectDirectory(const Caption: string; const Root: WideString;
out Directory: string): Boolean; overload;
2. function SelectDirectory(var Directory: string; Options: TSelectDirOpts;
HelpCtx: Longint): Boolean; overload;
из RxLib
TDirectoryEdit
function GetDirectory(nFolder: Longint): String;
var
Bi : TBrowseInfo;
lpName: array [0..MAX_PATH] of Char;
ppidl, aItemLst : PItemIDList;
begin
SHGetSpecialFolderLocation(Application.Handle, nFolder, ppidl);
FillChar(Bi, SizeOf(bi), 0);
Bi.hwndOwner := Application.Handle;
Bi.pidlRoot := ppidl;
Bi.pszDisplayName := lpName;
Bi.lpszTitle := 'Open directory';
aItemLst := SHBrowseForFolder(Bi);
CoTaskMemFree(ppidl);
SHGetPathFromIDList(aItemLst, lpName);
CoTaskMemFree(aItemLst);
Result := lpName;
end;
Пример использования (иначе не поймут, что такое nFolder)
// значения nFolder можно найти в описании
// к SHGetSpecialFolderLocation
// из Win32 Programmer's Reference (win32.hlp)
procedure TForm1.Button1Click(Sender: TObject);
begin
Caption := GetDirectory(CSIDL_DRIVES);
end;
Q-124: Как убрать из ListView горизонтальный скролбар навсегда?
type
TNoHScrollListview = Class( TListview )
private
Procedure WMNCCalcSize( Var msg: TMessage ); message WM_NCCALCSIZE;
end;
procedure TNoHScrollListview.WMNCCalcSize(var msg: TMessage);
var
style: Integer;
begin
style := getWindowLong( handle, GWL_STYLE );
If (style and WS_HSCROLL) <> 0 Then
SetWindowLong( handle, GWL_STYLE, style and not WS_HSCROLL );
inherited;
end;
by Peter Below
Q-125: Кaк искать oкнo по части eгo нaзвaния?
function FindNextWnd(StartHWND: HWND; AString : String): HWND;
var
Buffer : array [0..255] of char;
begin
Result := StartHWND;
repeat
Result := FindWindowEx(0, Result, nil, nil);
GetWindowText(Result, Buffer, SizeOf(Buffer));
if StrPos(StrUpper(Buffer), PChar(UpperCase(AString))) <> nil
then Break;
until (Result = 0);
end;
Q-126: Как обнаружить активность юзера?
Application.OnMessage := DoMessageEvent;
procedure TForm1.DoMessageEvent ( var Msg: TMsg;
var Handled: Boolean);
begin
case Msg.message of
WM_KEYFIRST..WM_KEYLAST,
WM_MOUSEFIRST..WM_MOUSELAST:
{Произошли события клавиатуры и мыши};
..
end;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-127: Как yзнать текущую Ru/En pаскладкy клавиатypы?
GetKeyboardLayoutName(buffer{:array [0..KL_NAMELENGTH] of Char});
case ((StrToInt('$'+ Buffer)) and $03FF) of
LANG_ENGLISH: Caption := 'Eng';
LANG_RUSSIAN: Caption := 'Rus';
end;
++++++++++++++++++++++++++++
procedure TForm1.Button1Click(Sender: TObject);
var
AklName: array [0..2] of Char;
begin
GetLocaleInfo( LoWord(GetKeyboardLayout(0)),
LOCALE_SABBREVLANGNAME,
AklName,
SizeOf(AklName));
Caption := AklName;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-128: Как передать строку другому приложению?
получатель:
procedure ReceiveMessage (var Msg: TMessage); message WM_COPYDATA;
..
procedure TFormReceive.ReceiveMessage;
var
pcd : PCopyDataStruct;
begin
pcd := PCopyDataStruct(Msg.LParam);
Caption := PChar(pcd.lpData);
end;
отправитель:
procedure TFormXXX.Button1Click(Sender: TObject);
var
cd : TCopyDataStruct;
begin
cd.cbData := Length(Edit1.Text)+1;
cd.lpData := PChar(Edit1.Text);
SendMessage ( FindWindow('TFormReceive', nil),
WM_COPYDATA,
0,
LParam( [@] cd));
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-129: Как RichEdit сделать скролл на конец текста?
with RichEdit do begin
SelLength := 0;
SelStart := Length(Text);
Perform(EM_SCROLLCARET,0,0);
end;
Q-130: Удаление файлов из временного каталога, безопасно ли?
При получении имени папки предназначенной для хранения временных файлов
могут возникнуть некоторые проблемы.
>> Прекрасно это выглядит, когда в качестве каталога временных файлов
назначен например C:\Windows
> :-) Я и говорю что небезопасно.
Особенно пикантно это выглядит, в свете того, что
Remarks
Windows 95/98/Me: The GetTempPath function gets the temporary file
path as follows:
The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined or if TMP specifies a
directory that does not exist. The current directory, if both TMP and TEMP
are not defined or specify nonexistent directories.
Этак переименовываешь C:\TEMP - и программа чистит текущий каталог :-)
Windows NT/2000 or later: The GetTempPath function does not verify that the
directory specified by the TMP or TEMP environment variables exists. The
function gets the temporary file path as follows:
The path specified by the TMP environment variable. The path specified by
the TEMP environment variable, if TMP is not defined. The Windows
directory, if both TMP and TEMP are not defined.
Этак удаляешь переменные окружения - и программа "деинсталлирует" Windows
Из этого вытекает следующее, удаление файлов из любого каталога, особенно из
временного чрезвычайно опасная операция, не ты создал - не трогай. Удалять
только ручками, глядя на файлы и принимая решения индивидуально по каждому
файлу.
При использовании функции GetTempPath проверить если подстрока TEMP в
результате и в случае отсутствия вхождения запросить пользователя для
принятия решения, с рекомендацией создать каталог TEMP и необходимые
переменные среды, лучше посоветоваться обратиться к администратору для
принятия решения. Это простое правило позволит избежать серьезных
последствий.
Тенцер А.Л. <tolik [@] katren.nsk.ru>
Andrew V. Fionik <fionika [@] chat.ru>
Anatoly Podgoretsky <anatoly [@] podgoretsky.com>
* Origin: Husky forever! (2:450/143.25)
ru.delphi FAQ [7-10]
Q-131: Как узнать состояние управляющих клавиш - Shift, Ctrl, Alt?
function IsKeyDown(vk: Word):Boolean;
begin
Result := GetKeyState(vk) and $8000 = $8000;
end;
vk для Ctrl, Shift, Alt соответственно равны: vk_control, vk_shift и vk_menu
Q-132: Как сохранить всю форму в файл (как Delphi в *.dfm)?
constructor TForm1.Create(AOwner: TComponent); // override;
var
fname: String;
begin
{ Для динамически создаваемых контролов, может требоваться
RegisterClasses(..); }
fname := FormFilename;
if FileExists( fname ) then
begin
CreateNew(AOwner);
ReadComponentResFile(fname, Self);
end
else
inherited Create( AOwner );
end;
procedure TForm1.FormCloseQuery( Sender: TObject;
var CanClose: Boolean);
begin
WriteComponentResFile(FormFileName, Self);
end;
{Peter Below, Vladimir Titov}
Q-133: Как контрол может сам себя разрушить?
TMyWinControl = class(TWinControl)
private
procedure WMuser1(var msg: TMessage); message WM_USER+1;
...
public
procedure Release;
...
end;
procedure TMyWinControl.WMuser1;
begin
Free;
end;
procedure TMyWinControl.Release;
begin
PostMessage(Handle, WM_USER+1, 0, 0);
end;
Q-134: Как отследить переход фокуса в приложении?
procedure TForm1.AppControlChange(Sender: TObject);
begin
if Sender is TScreen then
Caption := TScreen(Sender).ActiveForm.ActiveControl.Name;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := AppControlChange;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-135: Как заставить MediaPlayer крутить один и тот же клип?
procedure TForm1.WMUser1(var msg:TMessage);// message WM_USER+1;
begin
with MediaPlayer1 do begin
Previous;
Notify := True;
Play;
end;
end;
procedure TForm1.MediaPlayer1Notify(Sender: TObject);
begin
if (Sender as TMediaPlayer).NotifyValue = nvSuccessful then
PostMessage(Handle, WM_USER+1, 0, 0);
end;
Q-136: Как назначить процедуру собственному пункту системного меню?
const
cm_mycommand = $00A0;
procedure TForm1.FormCreate(Sender: TObject);
var HSysMenu: HMENU;
begin
HSysMenu:=GetSystemMenu(Handle,FALSE);
InsertMenu( HSysMenu, 0, MF_BYPOSITION or MF_STRING,
cm_mycommand, 'MyString');
end;
procedure TForm1.WMSysCommand (var Message:
TWMSysCommand); // message WM_SYSCOMMAND;
begin
case Message.CmdType of
cm_mycommand: ShowMessage('My Command');
else
inherited;
end;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-137: Какой класс окна у консоли?
'tty' for 9x
'ConsoleWindowClass' for NT
Q-138: Какое сообщение надо отлавливать в Application.OnMessage для
отслеживания клавиши Alt (vk_menu)
WM_SYSKEYDOWN/WM_SYSKEYUP
Q-139: Как спрятать контрол, если известен его Handle?
ShowWindow(ButtonHandle, SW_HIDE); // SW_SHOW
Q-140: Как поменять иконку и стpокy в заголовке консольного окна?
procedure TForm1.Button1Click(Sender: TObject);
var
h : HWND;
AIcon : TIcon;
begin
AllocConsole;
SetConsoleTitle(PChar('Console Title'));
Sleep(0);
h := FindWindow(nil, PChar('Console Title'));
AIcon := TIcon.Create;
ImageList1.GetIcon(0, AIcon);
SendMessage(h, WM_SETICON, 1, AIcon.Handle);
AIcon.Free;
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-141: Как сделать окно без VCL?
program Project1;
{ Copyright (c) 1996 by Charlie Calvert
Standard Windows API application written in Object Pascal.
No VCL code included. This is all done on the Windows API
level.
Note that you need to include both Windows and Messages!}
uses
Windows, Messages;
const
AppName = 'Window1';
function WindowProc(Window: HWnd; AMessage, WParam,
LParam: Longint): Longint; stdcall;
begin
WindowProc := 0;
case AMessage of
wm_Destroy: begin
PostQuitMessage(0);
Exit;
end;
end;
WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;
{ Register the Window Class }
function WinRegister: Boolean;
var
WindowClass: TWndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := [@] WindowProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := HInstance;
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := HBrush(Color_Window);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := AppName;
Result := RegisterClass(WindowClass) <> 0;
end;
{ Create the Window Class }
function WinCreate: HWnd;
var
hWindow: HWnd;
begin
hWindow := CreateWindow(AppName, 'Object Pascal Window',
ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
cw_UseDefault, cw_UseDefault, 0, 0, HInstance, nil);
if hWindow <> 0 then begin
ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
end;
Result := hWindow;
end;
var
AMessage: TMsg;
hWindow: HWnd;
begin
if not WinRegister then begin
MessageBox(0, 'Register failed', nil, mb_Ok);
Exit;
end;
hWindow := WinCreate;
if hWindow = 0 then begin
MessageBox(0, 'WinCreate failed', nil, mb_Ok);
Exit;
end;
while GetMessage(AMessage, 0, 0, 0) do begin
TranslateMessage(AMessage);
DispatchMessage(AMessage);
end;
Halt(AMessage.wParam);
end.
Q-142: Как избежать повторного запуска моего приложения?
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMCopyData(var msg: TMessage); message WM_COPYDATA;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
checkinst;
procedure TForm1.FormCreate(Sender: TObject);
var
h : HWND;
begin
h := SetUniqueUID(Handle, 123456); // назначаем уникальный идентификатор
if h <> Handle then
begin
SendString(h, GetCommandLineStr, Handle, 0);
ActivatePrevInstance(h);
Halt;
end;
end;
procedure TForm1.WMCopyData;
begin
Memo1.Lines.CommaText := PChar(PCopyDataStruct(msg.LParam).lpData);
end;
unit checkinst;
interface
uses
Windows,
Messages,
Sysutils;
function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
procedure ActivatePrevInstance(ahwnd: HWND);
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
function GetCommandLineStr: String;
implementation
function SetUniqueUID(ahwnd: HWND; uid: DWord): HWND;
var
ClassName: array [0..255] of Char;
begin
GetClassName(ahwnd, ClassName, SizeOf(classname));
Result := FindWindowEx(0, 0, ClassName, nil);
while (Result <> 0) do
if GetProp(Result, 'UID') = uid then
Exit
else
Result := FindWindowEx(0, Result, ClassName, nil);
SetProp(ahwnd, 'UID', uid);
Result := ahwnd;
end;
procedure ActivatePrevInstance(ahwnd: HWND);
var
h : HWND;
begin
h := GetWindowLong(ahwnd, GWL_HWNDPARENT);
if IsIconic(h) then
ShowWindow(h, SW_RESTORE);
SetForegroundWindow(h);
end;
procedure SendString(ahwnd:HWND; const s: String; aWParam: WParam;
dwData:DWord);
var
cds: TCopyDataStruct;
begin
cds.cbData := Length(s)+1;
cds.lpData := Pointer(s);
cds.dwData := dwData;
SendMessage(ahwnd, WM_COPYDATA, aWParam, LParam( [@] cds));
end;
function GetCommandLineStr: String;
var
i : Integer;
begin
for i := 0 to ParamCount do
Result := Result + ' ' + AnsiQuotedStr(ParamStr(i), '"');
end;
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
++++++++++++++++++++++++++++++++++++
=== Вариант с Мьютексом ===
В файле проекта (.dpr) прямо можешь написать нечто вроде:
uses windows,...
var
H: THandle;
begin
H := CreateMutex(nil, True, 'уникальное_имя_для_твоей_проги');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
H := FindWindow(nil, 'название заголовка окна программы');
SetForegroundWindow(H);
Exit;
end;
Application.Initialize;
Application.Title := 'название заголовка окна программы';
Application.CreateForm(TAppData, AppData);
Application.CreateForm(TMain, Main);
Application.Run;
CloseHandle(H);
end;
Прочко Денис Владимирович.
sysadmin [@] )farmeko.khv.ru
++++++++++++++++++++++++++++++++++++
Если быстро запустить дважды приложение, то вариант с поиском по классу окна
может не сработать, так как окно еще не успеет создаться
Анатолий Подгорецкий
Q-143: Как записать массив в файл?
with TFileStream.Create('array.dat', fmCreate or fmOpenWrite) do begin
WriteBuffer(a, SizeOf(a));
Free;
end;
Q-144: Delphi 6 требует Proxies.pas?
{$ifdef D_6_UP} // Это моя константа
DesignIntf, DesignEditors, DesignWindows, DsnConst,
{$else}
DsgnIntf,
{$endif}
Eugene Mayevski <mayevski [@] eldos.org>
Вопрос: Файл designeditors.pas использует 'proxies' в uses.
Исходный текст (proxies.pas) или откомпилированный модуль (proxies.dcu)
нигде не находится ни на моем жеском диске ни на D6 Pro CD..
Просто реорганизуйте ваш проект на использование runtime пакетов и добавьте
"DesignIDE" к вашемк списку runtime пакетов. Proxies находится здесь, и вам
не нужен исходный текст вообще.
Почему это сделано? Просто доя уверенности, что вы не сможете распространять
design time части (property editors, component editors), это запрещено по
личензии. DesignIDE.bpl не является свободно распространяемым, вы имеете
право использовать его только на машине на которой установлена Delphi,
подобно Component libraries.
forums.borland.com
Q-145: О библиотеке RxLib
Hа сайте delphiplus.org в разделе Бесплатно|RXLibrary
(delphiplus.spils.lv/RXLibrary.html) лежит RX Library 2.75 с help'ами
и четырьмя неофициальными портами RX Library 2.75 под Delphi 6:
1. Версия 1.1 (1.18M) от Oxygen Software
2. Версия 1 (1.36M) от Dennis Ortiz
3. Патч на RxLib версия 1.5 (437K) от Polaris Software
4. Версия от Epsylon Technologies
Anatoly Podgoretsky wrote:
> Hi, Delphi Plus!
> You wrote to Anatoly Podgoretsky on Tue, 20 Nov 2001 16:00:55 +0000 (UTC):
DP>> 14.11.2001 в раздел "Бесплатно|Компоненты" выложен четвертый
DP>> неофициальный порт RX Library 2.75 под Delphi 6 (от Epsylon
DP>> Technologies).
DP>> http://www.delphiplus.org - ежедневные новости информационных
DP>> технологий http://www.faq.delphiplus.org - коллекция FAQ по Delphi
> Прекрасно, этим я больше доверяю, а как вообще насчет характеристики всех
> четырех портов, а то у людей глаза разбегаются :-)
Epsylon Technologies
*************************
Здравствуйте!
Мы были вынуждены сделать свой вариант RxLib потому, что остальные нас
немного не устраивали.
Сразу скажу, зачем нам вообще нужна библиотека RxLib - она используется в
нашем продукте в качестве некоего примера всем известных компонентов.
Поэтому к такой библиотеке с нашей стороны предъявлялось требование
максимальной стандартности, если можно применить такой термин. Кроме того,
наш продукт поддерживает несколько версий Delphi и C++Builder, поэтому от
такой библиотеки требуется одновременная поддержка всех нужных нам версий
компиляторов.
Естественно, мы рассматривали варианты использования уже готовой работы по
адаптированию библиотеки под Delphi 6.0.
Однако:
- вариант от Polaris заточен для использования пакета Polaris Library.
Туда что-то добавлено, что-то починено, что-то переделано. Иначе
говоря, этот вариант не может быть стандартным;
- вариант от Oxygen является версией ТОЛЬКО под Delphi 6.0, содержит ряд
мелких неточностей при переводе design-time кода. Также там что-то
изменено по сравнению с 2.75. Кроме того, не переименован модуль
AppUtils.pas;
- вариант от Dennis Ortiz также является версией только под Delphi 6.0.
Hичего не могу сказать про нее - мы туда глубоко не заглядывали.
Hе совсем понятно, зачем выкидывать из библиотеки возможность поддержки
предыдущих версий Delphi, когда добавить вариант кода для Delphi 6.0 ничуть
не сложнее. Hикто также не против исправления каких-либо ошибок в
библиотеке, но давайте делать это централизованно, если уж авторы забили на
свое детище. Hапример, через тот же Source Forge.
Hаш вариант основан на общедоступном коде, и содержит модули из 2.75,
включая update от 16.12.1999 и патч для C+Builder 5.0 от 30.05.2000. В эти
модули добавлена возможность работы под Delphi 6.0, в том числе добавлен
макрос RX_D6 и переименованы модули AppUtils и StrUtils. Все. Hичего больше.
Hикакая старая функциональность не удалена, никакие баги не чинились. Полдня
работы.
==
Andrey Dementyev, Epsylon Technologies, www.epsylontech.com
Chief Software Architect
Информация от delphiplus
********************************
1. C 19-ого декабря компания SGB Software совместно с Hиком Ходж (Nick
Hodges) из Borland support team займется дальнейшим развитием RxLib.
Hадеются выпустить 3-ю версию к середине марта 2002 года. Все желающие могут
принять участие в этой работе, для этого достаточно написать на
RxLIb [@] SGBSoftware.com.
2. Hа DelphiPlus выложен материал "A где сейчас RXLib?" - заметка написанная
по материалам переписки в эхе fido7.ru.delphi. Hаконец эта история получила
завершение, афера SGB Software лопнула, но RXLib не погибла, а вошла в
состав более крупного проекта Jedi Code Library, за эти руки нет опасения,
все подробности на сайте delphiplus.org, благодаря которому мы были постянно
в курсе событий всех приключений с RXLib, спасибо.
* Origin: HPT is the best tosser! (2:450/143.25)
ru.delphi FAQ [8-10]
Q-146: Как хранить настройки программ.
Hижеприведенный текст являет собой вольное изложение отдельных статей
февральского выпуска Microsoft Platform SDK. Год 2001 от рождества Христова.
При проектировании способов хранения настроек своей программы следует
задаться тремя вопросами:
Что хранить.
Где хранить.
Как хранить.
Что хранить
Поскольку первая часть вопроса нам известна по определению, т.е. хранить мы
будем настройки программы, то перейдем ко второй части вопроса. Ваша
программа устанавливается на КОМПЬЮТЕР а пользуются ей ПОЛЬЗОВАТЕЛИ.
Соответственно все настройки разделяются на две части а то и на все три -
настройки которые относятся к компьютеру в целом, настройки которые
относятся ко всем локальным пользователям, настройки которые относятся к
конкретному пользовател. В зависимости от специфики программы первая и
вторая часть могут быть совмещены или разделены.
Поэтому важно сделать логическое разделение - какие настройки вашей
программы действительно специфичны для самого ПК, какие настройки должны
прилагаться ко всем пользователям, какие должны прилагаться к конкретному
пользователю. Кроме того Микрософт рекомендует чтобы настройки учитывали
возможную мобильность пользователя, т.е. для пользователя находящегося в
разных местах, возможно потребуется иметь разные наборы настроек.
Где хранить
Вообще в голову приходят три вещи.
Хранить настройки в системном реестре.
Хранить настройки в каталоге куда установлена программа.
Хранить настройки в системном каталоге Windows.
Хранить настройка в домашнем каталоге пользователя.
В Windows имеется три места предназначенных для хранения настроек которыми и
следует пользоваться.
Системный реестр
Домашний каталог пользователя (точнее один из его подкаталогов)
Общий каталог для пользователей
Прочие мысли о местах хранения настроек должны быть выброшены из голов как
вредные и противоестественные, Microsoft уже за вас все придумала и нефиг
извращаться. Для тех кто не понимает почему, объясняю. Hа нормальной ОС
(W'NT, W'2K) программа обычно запускается от имени и с правами конкретного
пользователя. Обычно, если этот пользователь не является администратором, он
имеет право изменять содержимое следующих ресурсов:
часть реестра HKEY_CURRENT_USER\*
содержимое своего домашнего каталога
содержимое временного каталога (который как правило находится внутри
домашнего)
содержимое некого каталога или каталогов специально выделенного для этого
администратором
При нормальном (читайте параноидальном) администрировании системы прочие
места либо доступны только в режиме чтения, либо вообще недоступны. В том
числе и папки \Program Files и Windows. Посему любая попытка программы
изменять любые файловые ресурсы окромя вышеуказанных черевата тем что ее
(программу) и его (пользователя) пошлют подальше. Причем далеко не в самой
вежливой форме.
Пример
Adobe Photoshop и его разработчики наивно полагают что им должны быть выданы
эксклюзивные права мусорить своими scratch-файлами в корневых каталогах
дисков, кроме того они полагают что им должна быть выдана в пользование в
режиме полный доступ часть системного реестра.. Временных каталогов,
специально выделенных для подобоного рода занятий, их не устраивает. Как
результат - Photoshop имеет серьезные проблемы с работой под Windows
NT/2000.
Системный реестр
С точки зрения хранения настроек программы системный реестр разделен на две
части. Это ветви HKEY_CURRENT_USER для хранения настроек специфичных для
пользователя, и HKEY_LOCAL_MACHINE для хранения настроек специфичных для
всего ПК и соответственно всех пользователей, работающих с этим ПК.
Рекомендуемая структура ветвей для хранения настроек программы -
HKEY_CURRENT_USER\Software\Company Name\Application Name\Version и
соответственно HKEY_LOCAL_MACHINE\Software\Company Name\Application
Name\Version. Параметры Company Name, Application Name, Version желательно
не хранить в виде hard-coded строк в коде программы а устанавливать в опциях
проекта (Project\Options\Version Info) и доставать впоследствии из ресурса с
помощью той же библиотеки RxLib. Альтернативный путь выбирать данные о
версии программы из ресурсов - использование Windows API
(GetFileVersionInfo, GetFileVersionInfoSize, VerQueryValue).
Программе следует расчитывать на то что доступ к подключам
HKEY_LOCAL_MACHINE разрешен в режиме только для чтения, а доступ к подключам
HKEY_CURRENT_USER допускает чтение, изменение и создание новых подключей и
значений.
Программе следует расчитывать на то что нужных ей ключей может не оказаться
в реестре или значения лежащие в реестре имеют неверный формат или
недопустимые значения. В таком случае, вместо несуществующих или неверных
значений настройки, программа должна использовать значения по умолчанию
которые разработчик может "железно забить в код" или получить с помощью
различных системных функций.
Hе следует использовать системный реестр для хранения больших кусков данных.
Вместо этого лучше хранить объемные данные в отдельном файле, а в реестре
запомнить имя этого файла.
Домашний каталог пользователя
Для хранения настроек слишком больших для того чтобы их размещать в реестре
существуют специально выделенные каталоги внутри домашнего каталога
пользователя. Эти каталоги обычно называются "специальными каталогами" и
имеют имена Application Data и Local Settings. Полный путь к ним можно
получить с помошью функций SHGetSpecialFolderPath или SHGetFolderPath.
Общий каталог пользователей
Обычно это каталог "Documents and Settings\All users". Внутри него имеются
такие-же подкаталоги для хранения настроек и данных программ но относящихся
ко всем пользователям. Полный путь к ним можно также получить с помошью
функций SHGetSpecialFolderPath или SHGetFolderPath.
Как хранить
Системный реестр
Для работы с системным реестром можно использовать функции Registry API
общим числом около 40 штук, а можно использовать классы из Registry.pas -
TRegistry, TRegistryIniFile, TRegIniFile. Особенно следует обратить внимание
на TRegistryIniFile который предоставляет упрощенную модель доступа к
системному реестру очень схожую с моделью работы с INI-файлами.
INI-файлы
Это старый метод хранения настроек программ, но все еще применяющийся
программистами. Hастройки хранятся в текстовом файле в виде:
[Section1]
Field1=Value1
Field2=Value2
FieldN=ValueN
[Section2]
Field1=Value1
Field2=Value2
FieldN=ValueN
[SectionN]
Field1=Value1
Field2=Value2
FieldN=ValueN
Для доступа к данным содержащимся в INI-файлах существуют классы из модуля
IniFiles - TIniFile, TMemIniFile.
Преимущество использования INI-файлов состоит в том что их можно легко
подредактировать с помощью текстового редактора. Они обычно легче
воспринимаются для прочтения нежели дерево ключей системного реестра.
Бинарные файлы настроек
Отдельно хочется поговорить о использовании бинарных файлов в качестве
хранилища для настроек программы. Обычные мотивы любителей использовать
бинарные файлы:
Экономится место
Hастройку можно спрятать от пользователя (сделать нечитабельной)
Первое глупо потому что информация о настройке занимает обычно немного места
и экономия достигается мизерная. Второе глупо потому что невозможность
просмотра и редактирования настроечных данных простыми средствами
(текстовый редактор) или встроенными (редактор реестра) создает больше
проблем как пользователю так разработчику, нежели пользы (причем весьма
сомнительной) от того что кто-то не сможет прочитать что написано в файле.
Кроме того использование бинарного файла нельзя назвать защитой от
нежелательного просмотра, т.к. любой "продвинутый пользователь" все равно с
помощью редактора бинарных файлов сможет просмотреть и разобраться в
содержимом настройки.
Заключение
Почти вся эта информация была вычерпана из кладезя мудрости под названием
Platform SDK (Software Development Kit), поставляемого в составе сборника
документации MSDN (Microsoft Software Developer Network). Разработчикам
настоятельно рекомендуется приобрести Platform SDK, это снимает огромную
массу вопросов связанную с программированием под Windows.
Q-147: Как вывести ProgresBar на StatusBar?
- --- Андрей Барташ
Gauge:=TGauge.Create(Form1);
Gauge.Parent:= StatusBar1;
Gauge.Top:=4;
Gauge.Left := 116;
Gauge.Height := 15;
Gauge.Width := 200;
Компонент TGauge находится на закладке Samples
I-148: Список рекомендуемой литературы
1. А. Архангельский, В. Ильин, М. Тагин
Русская справка (HELP) по Delphi 5 и Object Pascal (32 стр. с CD-ROM)
Бином, ISBN 5-7989-0168-8
2. А. Архангельский. Программирование в Delphi 5
Бином, ISBN 5-7989-0104-1
3. А. Архангельский. Программирование в Delphi 6
Бином, ISBN 5-7989-0227-7
4. П. Даpахвелидзе, Е. Маpков
Delphi 4 в подлиннике
5. П. Дарахвелидзе, Е. Марков, О. Котенок
Программирование в Delphi 5
BHV-СПб, ISBN 5-8206-0052-5
6) П.В. Шумаков, В.В. Фаронов "Delphi xx. Руководство разработчика баз
данных."
7) М.Кэнту
Delphi 4 для пpофессионалов
8. Ч.Калвеpт
Delphi 4, Энциклопедия пользователя
9. Стив Тейксейра, Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 1.
Основные методы и технологии программирования
Вильямс, ISBN 5-8459-0016-6
2000 Вильямс
10. Стив Тейксейра И Ксавье Пачеко
Delphi 5. Руководство разработчика. Том 2.
Разработка компонентов и работа с базами данных
2000 Вильямс
ISBN 5-8459-0066-2
11. Конопка Рей
Создание оригинальных компонент в среде Delphi: Пер. с англ./Рей Конопка.
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 512 с.
ISBN 5-7707-9551-4
12. Лишнер Рэй
Секреты Delphi 2: Пер. с англ./Рэй Лишнер. -
К.: HИПФ - "ДиаСофт Лтд.", 1996. - 800 с.
ISBN 966-7033-10-4
13. Том Сван "Секреты 32-разрядного программирования в Delphi"
Диалектика, Киев, 1997. 480 стр.,
ISBN 966-506-052-X (рус.)
14. Дэн Оузьер "Дельфи 2. Освой самостоятельно."
Восточная Книжная Компания,
1997. 624 стр. Binom.
15. Михаил Кpаснов. DirectX Гpафика в пpоектах Delphi
BHV
ISBN-5-94157-033-3
В списке отсутствует ряд хороших книг, по причине недостаточнысти данных,
если у кого есть замечания, исправления или дополнения по данной статье, то
просьба посылать их прямо на mailto: anatoly [@] podgoresky.com
Hовые книги можно искать и заказывать через Интернет на сайте
books.ru
Там же как правило есть аннотация.
Кроме указанных книг существует большое количество ресурсов в Интернете
посвященных Дельфи - это статьи, электронные библиотеки и прочее. Один из
ресурсов расположен на моем сайте - это несколько проектов электронных
библиотека, в совокупности свыше 200 книг. Доступ ко всем проектам прямо с
главной страницы www.podgoretsky.com, существует так же доступ и по
FTP (3 анонимных сессии)
Один из недостатков, это то что сервер сильно перегружен все 24 часа в
сутки, семь дней в неделю, поэтому скорость весьма низкая, поэтому
желательно использовать какой либо менеджер закачек, также не рекомендуется
использовать многопотоковую закачку, это не ускорит сам процесс закачки, а
только уменьшит возможность закачки для других пользователей.
Большинство книг с моего сервера, также доступны и на других серверах и если
есть возможность взять их из другого источника, то это будет более
оптимальным вариантом по скорости.
Q-149: Как нажать клавиши в другом приложении?
"Hажимаем" клавиши в Блокноте (уже запущенном):
uses Sendkey; {описан ниже}
procedure TForm1.Button1Click(Sender: TObject);
var
h: HWND;
begin
h := FindWindow('Notepad', nil); // ищем окно Блокнота
SendMessage(h, WM_SYSCOMMAND, SC_HOTKEY, h); // активизируем его
PlayKeys(StrToKeys('abcdef')); // нажимаем клавиши
SendMessage(Handle, WM_SYSCOMMAND, SC_HOTKEY, Handle); // возвращаем фокус
end;
Коды vk_ клавиш можно найти в Win32 Programmer's Reference (win32.hlp):
Virtual-Key Codes. {В дельфи не описаны коды клавиш ['A'..'Z'] и ['0'..'9'],
их получают с помощью Ord, например, Ord('A'), Ord('9')}.
Символы из верхнего ряда клавиатуры посылаются с нажатым Shift. Заметим, что
символы в локальной кодировке могут быть посланы после переключения
кодировки в активном приложении, например, если перключатель (switch)
Control-Shift, то это:
PlayKeys(Chr(vk_control)+#0+Chr(vk_shift)+#0); {downkey = #0};
- --- unit Sndkey.pas ---
unit sndkey;
interface
uses
Windows,
Messages;
const
{VK constants missing from windows.pas}
VK_SEMICOLON = 186; {;}
VK_EQUAL = 187; {=}
VK_COMMA = 188; {,}
VK_MINUS = 189; {-}
VK_PERIOD = 190; {.}
VK_SLASH = 191; {/}
VK_BACKQUOTE = 192; {`}
VK_LEFTBRACKET = 219; {[}
VK_BACKSLASH = 220; {\}
VK_RIGHTBRACKET = 221; {]}
VK_QUOTE = 222; {'}
downkey = #0;
upkey = Chr(KEYEVENTF_KEYUP); {#2}
procedure PlayKeys(const keys: String);
function StrToKeys(const s: String): String;
{Alt-F4:
PlayKeys(Chr(vk_menu)+#0+Chr(vk_f4)+#0+Chr(vk_f4)+#2+Chr(vk_menu)+#2)}
{"exit"<return>: PlayKeys(StrToKeys('exit'+chr(vk_return)));}
{"EXIT":
PlayKeys(Chr(vk_shift)+downkey+StrToKeys('exit')+Chr(vk_shift)+upkey));}
{or short form: PlayKeys(Chr(vk_shift)+#0+StrToKeys('exit'));}
implementation
function StrToKeys; {keystroke for alone keys}
var
i: Longint;
c: Char;
begin
for i := 1 to Length(s) do
begin
c := s[i];
if c in ['a'..'z'] then {Upper}
c := Chr(Ord(c) and not $20);
Result := Result + c + downkey
+ c + upkey;
end;
end;
procedure PlayKeys;
const
ExtendedKeys : set of byte =
[ vk_up, vk_down,
vk_left, vk_right,
vk_home, vk_end,
vk_prior, vk_next,
vk_insert, vk_delete];
var
i, ips : Longint;
fb, sb: Byte;
keysdown: String;
procedure keybd (vk, kp : Byte);
begin
if vk in ExtendedKeys then
kp := kp + KEYEVENTF_EXTENDEDKEY;
keybd_event(vk, MapVirtualKey(vk, 0), kp, 0);
end;
begin
keysdown := '';
for i := 1 to Length(keys) div 2 do
begin
fb:= Ord(keys[2*i -1]);
sb:= Ord(keys[2*i]);
if sb = Ord(downkey) then
keysdown := keysdown + Chr(fb)
else
begin
ips := pos(Chr(fb), keysdown);
if ips > 0 then
Delete(keysdown, ips, 1)
else
Continue;
end;
keybd(fb, sb);
end;
{Autocomplete}
for i := 1 to Length(keysdown) do
keybd(Ord(keysdown[i]), Ord(upkey));
end;
end.
- --- EOF unit Sndkey.pas ---
Leonid Troyanovsky <lv.t [@] eco-pro.ru>
Q-150: Как перетащить файлы из проводника в мою программу
TMainForm = class(TForm)
...
private
procedure WMDROPFILES(var Message: TWMDROPFILES); message
WM_DROPFILES;
procedure ProcessFile(Filename: string);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
DragAcceptFiles(MainForm.Handle, TRUE); // enable drag&drop
end;
procedure TMainForm.ProcessFile(Filename: string);
begin
// any actions
end;
procedure TMainForm.WMDROPFILES(var Message: TWMDROPFILES);
var
Files : Longint;
I : Longint;
Buffer : array[0..MAX_PATH] of Char;
begin
Files := DragQueryFile(Message.Drop,$FFFFFFFF,nil,0); // Get count of
files
for I := 0 to Files - 1 do begin
DragQueryFile(Message.Drop,I, [@] Buffer,SizeOf(Buffer)); // Get N file
ProcessFile(Buffer); // do something with the file
end;
DragFinish(Message.Drop); // end drag loop
end;
"Anatoly Podgoretsky" <anatoly [@] podgoretsky.com>
* Origin: Formatting C: ... (2:450/143.25)
ru.delphi FAQ [9-10]
Q-151: Как использовать в Дельфи API фyнкции
AA> как это ни странно, вызывать их. предварительно заюзав модуль windows.
Правильнее : вызвать, предварительно подключив модуль, в котором данная
функция описана (это может быть windows, activex, shellapi и т.д.).
Hайти модуль поможет клавиша F1 на имени функции.
Если функция не нашлась - то попробовать сделать поиск в папке с исходными
текстами Дельфи.
Если функция не нашлась - есть шанс, что в этой версии Дельфи она не
описана. В этом случае надо поискать "заголовочный файл" (API header file) в
интернете. Огромная коллекция их находится на сайте www.delphi-jedi.org.
Если не помогло и это - придется взять описание функции из документации
производителя данного API (обычно оно на С) и самому сделать ее обьявление,
так же, как это сделано в windows.pas, только в своем юните.
Сергей Кабиков
Q-152: Автоматическое определение кодировки текста
AG> Существуют ли в сободном для изучения доступе алгоритмы автоматического
AG> определения кодировки текста?
О, еще сколько. Методом таблицы модельных распределений:
type
TCodePage = (cpWin1251, cp866, cpKOI8R);
PMap = ^TMap;
TMap = array [#$80..#$FF] of Char;
function GetMap(CP: TCodePage): PMap;
{ должна возвращать указатель на таблицу перекодировки из CP в Windows1251
(nil для CP = cpWin1251) }
begin
GetMap:=nil;
end;
function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;
const
ModelBigrams: array [0..33, 0..33] of Byte = (
{АБВГДЕЖЗИЙКЛМHОПРСТУФХЦЧШЩЪЫЬЭЮЯ_Ё}
{А}(0,20,44,12,22,23,16,60,4,9,63,93,47,110,0,16,35,61,81,1,5,13,24,17,12,4,
0,0,0,0,14,31,205,1),
{Б}(19,0,0,0,4,19,0,0,8,0,2,15,1,4,41,0,15,5,0,15,0,2,1,0,0,6,16,37,0,0,0,4,
3,0),
{В}(97,0,1,0,2,57,0,5,40,0,4,25,2,23,78,2,8,28,4,12,0,1,0,0,8,1,0,40,1,0,0,5
,106,3),
{Г}(13,0,0,0,9,5,0,0,15,0,1,17,1,2,96,0,24,0,0,7,0,0,0,0,0,0,0,0,0,0,0,0,8,0
),
{Д}(63,0,9,1,2,71,1,0,35,0,3,16,2,22,50,2,19,9,2,25,0,2,1,0,1,0,1,9,4,0,1,5,
17,4),
{Е}(4,14,15,34,56,22,13,14,2,34,39,77,73,150,6,9,101,64,81,1,0,15,5,12,10,6,
0,0,0,0,3,4,235,1),
{Ж}(13,0,0,0,12,47,0,0,16,0,1,0,0,23,0,0,0,0,0,3,0,0,0,0,0,0,0,0,0,0,0,0,2,2
),
{З}(76,2,11,3,11,4,1,0,7,0,2,4,11,24,17,0,6,1,0,8,0,0,0,0,0,0,0,16,6,0,1,4,1
7,0),
{И}(7,9,32,5,18,60,4,42,31,27,28,46,55,49,12,7,26,60,53,0,5,25,14,28,4,1,0,0
,0,0,9,56,255,0),
{Й}(0,0,0,0,2,0,0,0,0,0,1,3,0,3,0,0,0,10,3,0,0,0,0,1,1,0,0,0,0,0,0,0,122,0),
{К}(92,0,3,0,0,7,2,1,39,0,0,27,0,14,110,0,18,5,35,18,0,0,11,0,0,0,0,0,0,0,0,
0,5,5,0),
{Л}(85,1,0,2,1,70,6,0,85,0,5,3,0,9,67,1,0,9,0,15,0,0,0,2,0,0,0,9,66,0,15,43,
57,4),
{М}(44,0,0,0,0,65,0,0,47,0,1,1,10,15,57,7,0,2,0,24,0,0,0,0,0,0,0,28,0,0,0,8,
109,3),
{}(139,0,0,1,11,108,0,4,152,0,7,0,1,69,161,0,0,8,25,24,5,1,5,2,0,1,0,83,10,0
,1,29,38,5),
{О}(0,72,139,76,74,32,32,19,12,52,21,93,68,72,7,34,93,102,98,1,2,6,6,19,15,2
,0,0,0,1,4,9,252,2),
{П}(17,0,0,0,0,43,0,0,14,0,1,9,0,1,125,3,120,1,2,8,0,0,0,0,0,0,0,3,6,0,0,3,2
,2),
{Р}(151,1,6,4,3,103,7,0,76,0,4,0,11,10,117,1,0,5,9,39,2,5,0,1,3,0,0,24,7,0,1
,10,22,5),
{С}(24,1,21,0,3,39,0,0,33,0,56,41,11,15,58,30,5,30,183,16,0,4,1,4,1,0,0,8,25
,0,1,50,41,2),
{Т}(83,0,43,0,3,87,0,0,71,0,9,3,2,26,180,0,55,33,1,23,1,0,1,4,0,0,0,20,78,0,
0,5,82,4),
{У}(3,6,7,14,19,8,13,6,0,1,13,15,10,7,0,12,17,16,19,0,1,3,0,12,5,8,0,0,0,0,2
2,1,65,0),
{Ф}(4,0,0,0,0,4,0,0,11,0,0,1,0,0,9,0,3,0,0,4,1,0,0,0,0,0,0,0,0,0,0,0,2,0),
{Х}(9,0,2,0,0,2,0,0,5,0,0,1,0,5,26,0,4,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,76,0),
{Ц}(5,0,0,0,0,16,0,0,48,0,1,0,0,0,4,0,0,0,0,3,0,0,0,0,0,0,0,2,0,0,0,0,3,0),
{Ч}(30,0,0,0,0,52,0,0,23,0,3,1,0,14,1,0,0,0,36,5,0,0,0,0,1,0,0,0,1,0,0,0,2,2
),
{Ш}(13,0,0,0,0,28,0,0,17,0,4,4,0,4,3,0,0,0,1,3,0,0,0,0,0,0,0,0,3,0,0,0,1,1),
{Щ}(6,0,0,0,0,23,0,0,16,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,0,1,0,0,0,0,1),
{Ъ}(0,0,0,0,0,16,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0),
{Ы}(0,5,14,1,3,28,0,2,0,22,6,19,21,2,0,5,4,7,10,0,0,37,0,3,4,0,0,0,0,0,0,1,8
4,0),
{Ь}(0,1,0,0,0,9,0,10,1,0,13,0,2,26,0,0,0,10,3,0,0,0,1,0,6,0,0,0,0,0,6,4,117,
0),
{Э}(0,0,0,0,0,0,0,0,0,0,3,3,0,0,0,0,0,0,31,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0),
{Ю}(0,5,0,0,3,0,0,0,0,0,0,1,0,0,0,0,0,1,15,0,0,0,1,4,1,15,0,0,0,0,0,0,38,0),
{Я}(0,0,9,2,7,10,3,19,0,0,1,6,7,8,0,0,2,6,19,0,0,3,5,1,0,3,0,0,0,0,5,2,177,0
),
{_}(42,80,193,43,109,41,18,53,159,0,144,27,83,176,187,229,70,231,99,47,15,13
,6,58,7,0,0,0,0,38,0,22,0,2),
{Ё}(0,0,0,0,3,0,0,0,0,0,2,4,4,8,0,0,5,3,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));
{ "рейтинг" буквы Ё условно принимается равным 1/20 от "рейтинга" буквы E,
если сочетание с участием Ё корректно, иначе - 0 }
type
TVariation = array [0..33, 0..33] of Integer;
var
I, J, iC, iPredC, Max: Integer;
C: Char;
CP: TCodePage;
D, MinD, Factor: Double;
AMap: PMap;
PV: ^TVariation;
Vars: array [TCodePage] of TVariation;
begin
DetermineRussian:=cpWin1251; { по yмолчанию }
{ вычисление распределений биграмм }
FillChar(Vars, SizeOf(Vars), 0);
for CP:=Low(Vars) to High(Vars) do begin
AMap:=GetMap(CP);
PV:= [@] Vars[CP];
iPredC:=32;
for I:=0 to Count - 1 do begin
C:=Buf[I];
iC:=32;
if C >= #128 then begin
if AMap <> nil then C:=AMap^[C];
if not (C in ['Ё', 'ё']) then begin
C:=Chr(Ord(C) and not 32); { 'a'..'я' -> 'А'..'Я' }
if C in ['А'..'Я'] then iC:=Ord(C) - Ord('А');
end
else
iC:=33;
end;
Inc(PV^[iPredC, iC]);
iPredC:=iC;
end;
end;
{ вычисление метрики и определение наиболее правдоподобной кодировки }
MinD:=0;
for CP:=Low(Vars) to High(Vars) do begin
PV:= [@] Vars[CP];
PV^[32, 32]:=0;
Max:=1;
for I:=0 to 33 do
for J:=0 to 33 do
if PV^[I, J] > Max then Max:=PV^[I, J];
Factor:=255 / Max; { ноpмализация }
D:=0;
for I:=0 to 33 do
for J:=0 to 33 do
D:=D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);
if (MinD = 0) or (D < MinD) then begin
MinD:=D;
DetermineRussian:=CP;
end;
end;
end;
begin
{ тест: слово 'Пример' в разных кодировках (веpоятность ошибок на таких
коpотких текстах высока - в данном слyчае пpосто повезло!) }
writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);
writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);
writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);
readln;
end.
--
Best regards,
Stas Malinovski. mailto:stasm [@] tsl.ru
Q-153: Как помигать лампочками на клавиатуре?
var
KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
KeyState[VK_NUMLOCK] := KeyState[VK_NUMLOCK] xor 1;
SetKeyboardState(KeyState);
end;
Изменяет состояние индикаторов на обратное...
См. также VK_NUMLOCK, VK_CAPITAL
WinNT:
{
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | 0, 0 );
keybd_event( VK_SCROLL, 0x46, KEYEVENTF_EXTENDEDKEY | KEYEVENTF_KEYUP,
0);
}
Stas Malinovski. mailto:stasm [@] tsl.ru
Q-154: Как создать в runtime форму
with TxxForm.Create(Self) do Show;
with TxxForm.Create(Self) do
try
ShowModal;
finally
Free;
end;
Q-155: Как прочитать порт или записать в него.
В мультизадачных ОС как правило доступ к портам запрещен идеологией системы.
И это неспроста - подумайте, что будет, если одновременно с вашей программой
этот же порт попробует использовать другая программа.
Hо в Win9x существует частичная возможность обратиться напрямую с помощью
ассемблерных команд. Делать это надо с определенной осторожность. Даже если
вы получите доступ до порта на своей машине, то это не означает, что это
будет и на другой машине, например доступ до LPT порта может быть закрыт
драйвером принтера, такое редко но встречается. Доступ к наиболее важным
портам прикрыты запрещен полностью соответствующими системными драйверами.
В Win NT доступ к оборудованию со стороны пользовательской программы
запрещен полностью. Для доступа на этих ОС требуется использовать kernel
mode драйвера, тоже самое рекомендуется и для Win9x.
Вот несколько полезных ссылок:
TVicHW32 www.entechtaiwan.com/tools.htm
Tinyport (NT)
www.winsite.com/info/pc/winnt/programr/tinypo21.zip.drag
DriverX www.tetradyne.com
giveio (NT)
www.wideman-one.com/gw/tech/Delphi/iopm/index.htm
Ports, by Harold Howe, www.bcbdev.com/components.htm
Код доступа к портам с помощью ассемблера.
procedure WritePortByte(Port:Word; Value:Byte);
asm
XCHG EDX,EAX
OUT DX,AL
end;
procedure WritePortWord(Port:Word; Value:Word);
asm
XCHG EDX,EAX
OUT DX,AX
end;
function ReadPortByte(Port:Word) : Byte;
asm
MOV EDX,EAX
IN AL,DX
end;
function ReadPortWord(Port:Word) : Word;
asm
MOV EDX,EAX
IN AX,DX
end;
Примечание:
Существуют устройства с подряд идущими (по адресам) _байтовыми_ портами, к
которым нельзя обращаться со словными командами I/O. Hа сегодня они почти
вымерли, но :
При выборе типа процедуры (BYTE или WORD) следует ориентироваться на
спецификацию устройства ввода-вывода, к которому идет
обращение. Hе следует обращаться к байтовому устройству с
WORD-ориентированными процедурами - экономия времени мизерная, а побочные
эффекты могут быть катастрофическими."
Hапример, некоторые адаптеры сбрасывают биты ошибок после чтения
статус-регистра. Другие отображают несколько внутренних регистров на один
адрес I/O, и т.п.
Hа некоторых старых компьютерах Word процедуры могут не работать из за
специфических особенностей интерфейса, правда такие компьютера практически
уже не встречаются. Есть ISA Bus Specification, где эти вопросы четко
формализованы. Выборка словного порта может быть разбита на два раза, даже
если адрес четный, в зависимости от пожеланий устройства I/O.
Q-156: Как работать с битами?
Есть два способа.
Hизкоуровневый подход обеспечивается логическими операциями :
var
I : integer;
N : integer; // Hомер бита в диапазоне от
0..SizeOf(TYPE)*8 - 1
I := I or (1 shl N); // установка бита
I := I and not (1 shl N); // сброс бита
I := I xor (1 shl N); // инверсия бита
if (i and (1 shl N)) <> 0 then... // проверка установленного бита
Высокоуровневый подход опирается на представление числа в виде множества:
type
TIntegerSet = set of 0..SizeOf(Integer)*8 - 1;
var
I : Integer;
N : Integer;
Include(TIntegerSet(I), N); // установили N-ный бит в 1
Exclude(TIntegerSet(I), N); // сбросили N-ный бит в 0
if N in TIntegerSet(I) then... // проверили N-ный бит
Q-157: Как удалить непустой каталог?
procedure TForm1.Button1Click(Sender: TObject);
var
lpFileOp: TSHFileOpStruct;
begin
FillChar(lpFileOp,SizeOf(lpFileOp),0);
lpFileOp.Wnd := Handle;
lpFileOp.wFunc := FO_DELETE;
lpFileOp.pFrom := PChar(Edit1.Text);
lpFileOp.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(lpFileOp);
end;
Ivan Daniloff <<abc12345 [@] eprst.ru>>
Q-158: Как получить список файлов со всеми подкаталогами
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then
List.Add(StartDir + SearchRec.Name)
else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
begin
List.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;
Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для резульатат, любой наследник от TString, например
TStringList
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir('c:','',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;
Анатолий Подгорецкий
anatoly [@] podgoretsky.com
В связи с тем, что многие не понимают работу с масками, например пытаются
искать файлы *.txt во всех подкаталогах, вот модифицированная версия для
поиска файлов, которая для поиска подкаталогов использует мвску *.*, а для
файлов указанную маску.
Процедура представлена Юрием Зотовым.
procedure FindAllFiles(List: TStrings; Dir, Mask: string);
procedure ScanDir(Dir: string);
var
SR: TSearchRec;
begin
Dir := IncludeTrailingBackSlash(Dir);
if FindFirst(Dir + '*.*', faAnyFile - faVolumeID, SR) = 0 then
try
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then
if SR.Attr and faDirectory <> 0 then
ScanDir(Dir + SR.Name)
else
if MatchesMask(SR.Name, Mask) then
List.Add(Dir + SR.Name)
until FindNext(SR) <> 0
finally
FindClose(SR)
end
end;
begin
if (List = nil) or not DirectoryExists(Dir) or (Mask = '') then
raise Exception.Create('Invalid parameter');
List.Clear;
ScanDir(Dir)
end;
Примечания: функция MatchesMask существует только с определенных версий
Дельфи, как минимум в 5 есть.
Q-159: Как преобразовать unix time в TDateTime
unix timestamp представляет собой число секунд начиная с 1.01.1970
const
SecPerDay = 86400;
Offset1970 = 25569;
function UnixTimeToDateTime(UnixTime : LongInt): TDate;
begin
Result := UnixTime / SecPerDay + Offset1970;
end;
function DateTimeToUnixTime(DelphiDate : TDate) : LongInt;
begin
Result := Trunc((DelphiDate - Offset1970) * SecPerDay);
end;
Если необходима корректировка зимнего/летнего времени, то ее следует сделать
самостоятельно.
Q-160: Как сделать .manifest для Windows XP
Для того, чтобы программы запускаемые под Windows XP, имели новый вид,
необходимо вместе с программой поставить файл *.manifest или включить его в
ресурс.
Для это изготовить файл, по ниже приведенной инструкции, назвать его
Project1.exe.manifest, по положить рядышком с Project1.exe, после это
запускаешь под XP и радуешься :-)
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="*" name="Igor.Schevchenko.XPUtilsTest" type="win32">
<description>XP User utils test</description>
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*" />
</dependentAssembly>
</dependency>
</assembly>
Строчку name="Igor.Schevchenko.XPUtilsTest" меняешь на
name="Kostya.Ergin.Project1"
С уважением,
Игорь Шевченко
++++++++++++++++++++++++++++++
В Delphi Studio 7 Enterprise и Professional, приложения Borland VCL теперь
включают компоненты, которые разрешают поддержку WindowsR общих контролов
версии 6. Ваше приложение автоматически использует новые контролы Windows на
системе Windows XP, если найдет подходящий манифест файл. Более подробно об
этом в руководстве Developer's Guide тема "Common controls and XP themes"
или в справочной системе.
Анатолий Подгорецкий
* Origin: Formatting C: ... (2:450/143.25)
ru.delphi FAQ [10-10]
Q-161: Как узнать версию программы
function GetFileVersion(const FileName: TFileName; var Major, Minor,
Release, Build: Integer): Boolean;
var
InfoSize, Wnd: DWORD;
VerBuf: Pointer;
FI: PVSFixedFileInfo;
VerSize: DWORD;
begin
Result:= False;
InfoSize:= GetFileVersionInfoSize(PChar(FileName), Wnd);
if InfoSize <> 0 then begin
GetMem(VerBuf, InfoSize);
try
if GetFileVersionInfo(PChar(FileName), Wnd, InfoSize, VerBuf) then
if VerQueryValue(VerBuf, '\', Pointer(FI), VerSize) then begin
Major:= FI.dwFileVersionMS shr 16;
Minor:= FI.dwFileVersionMS and $FFFF;
Release:= FI.dwFileVersionLS shr 16;
Build:= FI.dwFileVersionLS and $FFFF;
Result:= True;
end;
finally
FreeMem(VerBuf);
end;
end;
end;
Ilya Katargin <Ilya.Katargin [@] f9.n5029.z2.fidonet.org>
function GetFileVersion(FName: TFileName): String;
var
S: String;
n, Len: Cardinal;
Buf, Value: PChar;
begin
Result:='';
S := FName;
n := GetFileVersionInfoSize(PChar(S), n);
if n = 0 then Exit;
Buf := AllocMem(n);
GetFileVersionInfo(PChar(S), 0, n, Buf);
if VerQueryValue(Buf, PChar('StringFileInfo\041904E3\FileVersion'),
Pointer(Value), Len) then
Result:=Value;
FreeMem(Buf, n);
end;
шеп <шеп [@] p256.f1355.n5020.z2.fidonet.org>
> if VerQueryValue(Buf, PChar('StringFileInfo\041904E3\FileVersion'),
Здесь жестко прописан язык и кодовая страница '041904E3'.
В хелпе к Д6 тоже прописано жестко: '040904E4' (см. Reading version
information в хелпе). Я ,кстати, сам не сразу сообразил, что это значение
в хелпе не работает для русского языка :(
А ведь это значение можно взять там же:
type
TLangChrSet = array[0..1] of word;
PLangChrset = ^TLangChrSet;
var
LangChrSet: PLangChrSet;
после получения FileVersionInfo
VerQueryValue(Buf, PChar('VarFileInfo\Translation'),
pointer(LangChrset), Len);
S:=Format('%.4x%.4x',[LangChrSet^[0], LangChrSet^[1]]);
теперь в S у нас то, что надо :)
С Уважением, Евгений Переверзев.
Eugene [@] asv.afn.ru
Q-162: Как выключить или презагрузить компьютер
procedure Shutdown(Flags: DWORD);
var
hToken: THandle;
Luid: Int64;
NewPrivileges: TTokenPrivileges;
OldPrivileges: TTokenPrivileges;
OldPrivilegesSize: DWORD;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT
then // получения привилегий для платформы NT
begin
// получения локального уникального ИД
Win32Check(LookupPrivilegeValue(nil, 'SeShutdownPrivilege', Luid));
// получения токена процесса
Win32Check(OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken);
NewPrivileges.PrivilegeCount := 1;
NewPrivileges.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
NewPrivileges.Privileges[0].Luid := Luid;
// настройка привилегий
AdjustTokenPrivileges(hToken,
False,
NewPrivileges,
SizeOf(OldPrivileges),
OldPrivileges,
OldPrivilegesSize);
try
Win32Check(GetLastError = ERROR_SUCCESS);
finally
CloseHandle(hToken);
end
end;
Win32Check(ExitWindowsEx(Flags, 0));
end;
Вызов: Shutdown(EWX_SHUTDOWN or EWX_POWEROFF);
Флаги можно комбинировать c помощью оператора OR
EWX_FORCE - принудительное выполнение операций, без сохранения данных.4
EWX_LOGOFF - выход из сеанса текущего пользователя;
EWX_POWEROFF - выключение питания;
EWX_REBOOT - пеpезагpузка Windows;
EWX_SHUTDOWN - выключение Windows, точка в которой безопасно выключать
питание.
В разработке темы приняли многие участники конференции, особая благодарность
Andrey Gusev <Andrey.Gusev [@] p11.f121.n5050.z2.fidonet.org> и Leonid
Troyanovsky <lv.t [@] eco-pro.ru>
===
Также можно использовать функцию InitiateSystemShutdown. С помощью данной
ф-и можно выключать/перезагружать и удаленные компьютеры в локальной сети.
Только в этом случае дополнительно необходимо иметь привилегию
SeRemoteShutdownPrivilege.
Бакланов Денис <dbacklanov [@] incon.ru>
Q-163: Куда пропали те или другие компоненты в Д7
Последнее время часто задаются вопросы, куда девались те или другие
компоненты в Д7. Большинство из них некуда не девалось, а просто не
инсталлировано. Для инсталляции надо найти соответсвующий bpl файл в папке
BIN и проинсталлировать. По ряду компонент надо поискать readme, которые
могут находиться в других папках, например в DEMOS/
P.S. Если ктото приведет список bpl файлов, то статья будет дополнена данной
информацией.
Client/ServerSocket - delphi7\bin\dclsockets70.bpl
Quick Report - delphi7\bin\dclqrt70.bpl
TeeChart = delphi7\Bin\dcltqr70.bpl
Анатолий Подгорецкий
podgoretsky.com
Q-164: Время работы Windows
//Возврат времени работы Windoes
// в формате TDateTime
function WindowsUptimeDays: TDateTime;
var
lpPerformanceCount: Int64;
lpFrequency: Int64;
begin
if QueryPerformanceCounter(lpPerformanceCount) then
begin
QueryPerformanceFrequency(lpFrequency);
// в отличие от GetTickCount будет работать более 49 суток
Result := lpPerformanceCount / lpFrequency / SecsPerDay;
end
else
// на случай, если нет мультимедийного таймера
Resul t:= GetTickCount/MSecsPerDay;
end;
//Возврат времени работы Windoes
//в формате d, hh:mm:ss
function WindowsUptimeStr: string;
var
DT: TDateTime;
begin
DT := WindowsUptimeDays:
Result := (Trunc(DT)) + ', ' + TimeToStr(DT);
end;
Вызов
S := WindowsUptimeToStr(WindowsUptime):
"Слава Сысолятин" <slava [@] magicbitsoft.com>
* Origin: Programming in progress... (2:450/143.25)
Комментарии |
| отсутствуют |
Добавление комментария |