500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу


Функция keybd_event() принимает значения до 244 - как мне отправить нажатие клавиши с кодом #255 в элемент управления Windows?

Это может понадобится для иностранных языков или для специальных символов. (например,
в русских шрифтах символ с кодом #255 - я прописное). Приведенный в примере метод,
не стоит использовать в случае если символ может быть передан обычным способом
(функцией keybd_event()).

procedure TForm1.Button1Click(Sender: TObject);
var
KeyData : packed record
RepeatCount : word;
ScanCode : byte;
Bits : byte;
end;
begin
{Let the button repaint}
Application.ProcessMessages;
{Set the focus to the window}
Edit1.SetFocus;
{Send a right so the char is added to the end of the line}
// SimulateKeyStroke(VK_RIGHT, 0);
keybd_event(VK_RIGHT, 0,0,0);
{Let the app get the message}
Application.ProcessMessages;
FillChar(KeyData, sizeof(KeyData), #0);
KeyData.ScanCode := 255;
KeyData.RepeatCount := 1;
SendMessage(Edit1.Handle, WM_KEYDOWN, 255,LongInt(KeyData));
KeyData.Bits := KeyData.Bits or (1 shl 30);
KeyData.Bits := KeyData.Bits or (1 shl 31);
SendMessage(Edit1.Handle, WM_KEYUP, 255, LongInt(KeyData));
KeyData.Bits := KeyData.Bits and not (1 shl 30);
KeyData.Bits := KeyData.Bits and not (1 shl 31);
SendMessage(Edit1.Handle, WM_CHAR, 255, LongInt(KeyData));
Application.ProcessMessages;
end;

Некоторые компоненты не меняют курсор мыши до тех пор пока пользователь не сдвинет мышь. Как эмулировать движение мыши?

В примере мышка слегка "подталкивается" без участия пользователя.

procedure TForm1.Button1Click(Sender: TObject);
var
pt : TPoint;
begin
Application.ProcessMessages;
Screen.Cursor := CrHourglass;
GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y + 1);
Application.ProcessMessages;
SetCursorPos(pt.x - 1, pt.y - 1);
end;

Как зарегистрировать расширение файла за своим приложением и контекстное меню, связанное с этим типом?

Пример регистрирует расширение файла(.myext) - файлы этого типа будут открываться
приложением MyApp.Exe. Также регнстрируется одно действие (action) по умолчанию
для файлов этого типа и два дополнительных пункта контекстного меню, связанного с
этим типом файлов. Возможно, потребуется перезайти в систему чтобы изменения
вступили в силу.

uses
Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do
begin
RootKey := HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action',
'','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action',
'','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;

Как минимизиpовать все запущеные окна?

{$APPTYPE CONSOLE}
program Minimize;
uses Windows,Messages;
var
Count : integer;

function EnumProc (WinHandle: HWnd; Param: LongInt): Boolean; stdcall;
begin
if (GetParent (WinHandle) = 0) and (not IsIconic (WinHandle)) and (IsWindowVisible (WinHandle)) then
begin
PostMessage (WinHandle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
Inc(Count);
end;
EnumProc := TRUE;
end;

begin
Count:=0;
EnumWindows (@EnumProc, 0);
Writeln('Minimized:',Count,' windows');
end.

Как заставить появляться хинт, когда я захочy?

{Появление}
if h<>nil H.ReleaseHandle; {если чей-то хинт yже был, то его погасить}
H:=THintWindow.Create(Окно-владелец хинта);
H.ActivateHint(H.CalcHintRect(...),'hint hint nint');
....
{UnПоявление :) - это возможно пpидется повесить на таймеp, котоpый бyдет
обнyляться пpи каждом новом появлении хинта}
if h<>nil H.ReleaseHandle;

По-дpyгомy задача тоже pешаема, но очень плохо. (см исходник объекта
TApplication, он как pаз сабжами заведyет.

Как пpогpамно вывести окно свойств экpана?

ShellExecute(Application.Handle, 'open', 'desk.cpl', nil, nil, sw_ShowNormal);

Как вывести окно свойств компьютеpа?

ShellExecute(Application.Handle, 'open', 'sysdm.cpl', nil, nil, sw_ShowNormal);

Как проверить активно ли интернет соединение (как пинговать узел?) ?

Попробуй пинговать какой-нить www.microsoft.com. Hадеюсь, узла с таким
именем нет в вашей локальной сети.

function TMailer.PingHost(HostName: String): boolean;
var
H: PHostEnt;
WSDATA: WSADATA;
I,AutoConnectState: Integer;
begin
Result := False;
With TRegistry.Create do
try
{ Отключам автоматическое подключение через модем }
OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings', False);
ReadBinaryData('EnableAutodial', AutoConnectState, SizeOf(AutoConnectState));
I := 0;
WriteBinaryData('EnableAutodial', I, SizeOf(I));
{ Загружаем библиотеку WinSock }
if WSAStartup(MAKEWORD(1, 0), WSDATA) <> 0 then
begin
{ ошибка получилась :-( }
Exit;
end;
H := GetHostByName(PChar(HostName));
Result := H <> nil;
finally
WriteBinaryData('EnableAutodial', AutoConnectState, SizeOf(AutoConnectState));
WSACleanup;
Free;
end;
end;

Как очистить коpзинy?

Есть функция SHEmptyRecycleBin (в shell32.dll), но она не документирована (по крайней мере в win32.hlp ее нет).

Как работать с плагинами ?

Я сделал так - выбираю все DLL из каталога с программой, загружаю каждую и пытаюсь найти в ней функцию (через API GetProcAddress) с заранее определенным жестко именем (например что нибудь типа IsPluginForMyStuff). Если нашлась - DLL считается моим плагином, если нет - выгрузить и забыть.

А набор вызываемых функций по идее одинаков у всех плагинов, и программа (основная) в курсе какие именно функции она ищет в DLL. Если даже и не так, то ничего не мешает тебе определить в плагине функцию наподобие GetFeatures, возвращающую список строк-названий поддержанных плагином процедур.

Вот часть моего кода по работе с плагинами...

=================
...
type
// Процедурные типы для хранения ссылок на функции плагинов
TGetNProc=function:shortstring;
TGetSProc=function:integer;
TProcessProc=procedure(config:pointer; request:PRequest; var reply:PReply);
TConfigProc=procedure(defcfg:PSysConfig; var config:pointer);
TSaveLoadProc=procedure(inifile:pointer; var config:pointer);

// Информация об отдельном плагине
TPlugin=record
Name:shortstring; // Полное название
Filename:shortstring; // Имя файла
Handle:integer; // Хэндл загруженной DLL
CFGSize:integer; // Размер конфигурации в RAM
ProcessProc: TProcessProc; // Адрес процедуры обработки
ConfigProc: TConfigProc; // Адрес процедуры настройки
LoadCFG,SaveCFG:TSaveLoadProc; // Адреса процедур чтения/записи cfg
end;
PPlugin=^TPlugin;

// Список загруженных плагинов
TPlugins=class(TList);

...

var
Plugins:TPlugins; sr:TSearchRec; lib:integer;
pgetn:TGetNProc; pgets: TGetSProc; plugin:PPlugin;

...

// Читаем плагины и создаем их список.
Plugins:=TPlugins.Create;
if FindFirst('*.dll',faAnyFile,sr)<>0 then begin
ShowMessage('Hе найдено подключаемых модулей.');
Close;
end;
repeat
lib:=LoadLibrary(PChar(sr.Name));
if lib<>0 then begin
@pgetn:=GetProcAddress(lib, 'GetPluginName');
if @pgetn=nil then FreeLibrary(lib) // Hе плагин
else begin
New(plugin);
@pgets:=GetProcAddress(lib, 'GetCFGSize');
plugin.Name:=pgetn;
plugin.Filename:=sr.Name;
plugin.CFGSize:=pgets;
plugin.Handle:=lib;
plugin.ConfigProc:=GetProcAddress(lib, 'Configure');
plugin.ProcessProc:=GetProcAddress(lib, 'Process');
plugin.SaveCFG:=GetProcAddress(lib, 'SaveCFG');
plugin.LoadCFG:=GetProcAddress(lib, 'LoadCFG');
Plugins.Add(plugin);
end;
end;
until FindNext(sr)<>0;
FindClose(sr);
...

Как таскать окно за нужный мне элемент на нём?

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
SC_DragMove = $F012; { a magic number }
begin
ReleaseCapture;
panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

Перетаскивание формы за любое её место.

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
begin
if PtInRegion(rgn, Message.XPos, Message.YPos) then
Message.Result := HTCAPTION
else
Message.Result := HTNOWHERE;
end;

Как поместить иконку в Tray ?

function TaskBarAddIcon( hWindow : THandle; ID : Cardinal; ICON : hicon; CallbackMessage : Cardinal; Tip : String ) : Boolean;
var
NID : TNotifyIconData;
begin
FillChar( NID, SizeOf( TNotifyIconData ), 0 );
with NID do
begin
cbSize := SizeOf( TNotifyIconData );
Wnd := hWindow;
uID := ID;
uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
uCallbackMessage := CallbackMessage;
hIcon := Icon;
if Length( Tip ) > 63 then SetLength( Tip, 63 );
StrPCopy( szTip, Tip );
end;
Result := Shell_NotifyIcon( NIM_ADD, @NID );
end;

Как передать фокус следующему контролу ?

Perform(WM_NEXTDLGCTL, 0, 0).

Как вытащить VersionInfo из свойств проекта дабы ее потом использовать в окнах типа About (Label, StaticText, etc)?


function CurrentFileInfo(NameApp : string) : string;
var
dump: DWORD;
size: integer;
buffer: PChar;
VersionPointer, TransBuffer: PChar;
Temp: integer;
CalcLangCharSet: string;
begin
size := GetFileVersionInfoSize(PChar(NameApp), dump);
buffer := StrAlloc(size+1);
try
GetFileVersionInfo(PChar(NameApp), 0, size, buffer);
VerQueryValue(buffer, '\VarFileInfo\Translation', pointer(TransBuffer), dump);
if dump >= 4 then
begin
temp:=0;
StrLCopy(@temp, TransBuffer, 2);
CalcLangCharSet:=IntToHex(temp, 4);
StrLCopy(@temp, TransBuffer+2, 2);
CalcLangCharSet := CalcLangCharSet+IntToHex(temp, 4);
end;

VerQueryValue(buffer, pchar('\StringFileInfo\'+CalcLangCharSet+'\'+'FileVersion'), pointer(VersionPointer), dump);
if (dump > 1) then
begin
SetLength(Result, dump);
StrLCopy(Pchar(Result), VersionPointer, dump);
end
else
Result := '0.0.0.0';
finally
StrDispose(Buffer);
end;
end;

Как определить есть ли некоторое свойство(например, Hint) у объекта ?

TypInfo .GetPropInfo (My_Component.ClassInfo, 'Hint') <> nil

Таким образом можно узнать наличие таковой published "прОперти".
А вот если это не поможет, то можно и "ломиком" поковыряться посредством FieldAddress. Однако этот метод дает адрес полей, которые перечисляются сразу после объявления класса как в unit'ых форм.
А вот ежели "прОперть" нигде не "засветилась" (published) то фиг ты ее достанешь.
А модифицировать значение можно посредством прямой записи по адресу FieldAddress (крайне нежелательно!) либо используя цивилизованный способы, перечисленные в unit'е TypInfo.

2AS: Модифицировать кучу объектов можно организовав цикл перебора оных с получением в цикле PropertyInfo объекта и записи в объект на основе PropInfo.

Как послать некое сообщение всем формам ?

var
I: Integer;
M: TMessage;
...
with M do
begin
Message := ...
...
end;

for I := 0 to Pred(Screen.FormCount) do
begin
PostMessage( Forms[I].Handle, ... );
// Если надо и всем чилдам
Forms[I].Broadcast( M );
end;

Как DLL правильно заполнить строковыми ресурсами, и потом достать их ?

Делаешь текстовый файл с ресурсами, типа

--my.rc--
STRINGTABLE
{
00001, "My String #1"
00002, "My String #2"
}
Далее компилируешь его:
brcc32 my.rc
У тебя получится my.res.

Делаешь DLL:
--my.dpr--
library my;
{$R my.res}
begin
end.
Компилируешь Дельфиским компилятором:
dcc32 my.dpr
Получаешь, наконец-то свою my.dll

Теперь о том, как использовать.
В своей программе:
var
h : THandle;
S: array [0..255] of Char;
begin
h := LoadLibrary('MY.DLL');
if h <= 0 then
ShowMessage('Bad Dll Load')
else
begin
SetLength(S, 512);
LoadString(h, 1, @S, 255);
FreeLibrary(h);
end;
end;

Подскажите пожалуйста как сделать имитацию ввода с клавиатуры для программы выполняющейся в дос-окне?

const
ExtendedKeys: set of Byte = [ // incomplete list
VK_INSERT, VK_DELETE, VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_NUMLOCK ];

procedure SimulateKeyDown(Key : byte);
var
flags: DWORD;
begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
keybd_event(Key, MapVirtualKey(Key, 0), flags, 0);
end;

procedure SimulateKeyUp(Key : byte);
var
flags: DWORD;
begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
keybd_event(Key, MapVirtualKey(Key, 0), KEYEVENTF_KEYUP or flags, 0);
end;

procedure SimulateKeystroke(Key : byte);
var
flags: DWORD;
scancode: BYTE;
begin
if Key in ExtendedKeys then flags := KEYEVENTF_EXTENDEDKEY else flags := 0;
scancode := MapVirtualKey(Key, 0);
keybd_event(Key,
scancode,
flags,
0);
keybd_event(Key,
scancode,
KEYEVENTF_KEYUP or flags, 0);
end;


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz