Вопросы и решения

Статус
В этой теме нельзя размещать новые ответы.

Avangard

Участник
OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, WndProcCallBack(@MyProc, 4)); - это указание хендлу, что он должен использовать эту процедуру, для обработки поступающих сообщений.
В дельфи, для этого, не нужно подключать Каллбэк, она и так знает, чего это такое :)
[hr]
:facepalm: Тот пример для Инно
 

LexBell

Борода
Супер модератор
dvd4el, Блин, ну что ты, как маленький? вроде раньше меня начал длл-ки ваять под инно? Неужели оттолкнувшись от подсказки поискать влом? или не повзрослел до сих пор, и будешь дальше просить, за тебя все сделать? Ссылка. А лучше так: Ссылка. - почти все ссылки указывают на различные примеры работы с оконными процедурами.

Добавлено через 8 минут
Тот пример для Инно
да, но в дельфи аналогично подменяется оконная процедура :) Просто инно, с помощью таймера, приходится объяснять, как оконные сообщения обрабатывать, а дельфи этого объяснять не нужно, и можно тот пример брать почти без переделки, отрезав все лишнее и заменив сообщения на нужные. это уже даже мне понятно :)
 
Последнее редактирование:

DaRKdemoN

Участник
Проверенный
OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, WndProcCallBack(@MyProc, 4));
пиши так:
OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, @NewWndProc);

Добавлено через 47 секунд
Просто инно, с помощью таймера,
стоп, с какого ещё таймера?

Добавлено через 1 минуту
dvd4el
в данной мною статье надо пролистать пол страницы и ты увидишь вполне рабочий пример
 

DaRKdemoN

Участник
Проверенный
dvd4el
Program SampleProject03;

{$R *.res}

{$R WinXP.res}

Uses

Windows,

Messages,

SysUtils;

Procedure InitCommonControls; Stdcall; External 'comctl32.dll';

Const

{ Идентификатор таймера }

BtnTimer = 450;

{ Константы с заголовками дочерних окон }

StaticInfoText = 'Метка без сабклассирования';

BtnText = 'Кнопка для сабклассирования';

Var

{ Главное окно }

HWnd: THandle;

{ Три дочерних компонента для сабклассирования }

Btn, Edit, InfoStatic: THandle;

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }

Procedure SetDefFont(AWindow: THandle);

Begin

SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);

End;

{ Косвенно-вызваемая процедура сообщений таймера }

{ Эта процедура выполняется при каждом срабатывании таймера }

Procedure BtnTimerProc(HWnd: THandle; Msg: Cardinal;

IDEvent, DWTime: Cardinal); Stdcall;

Var

{ Переменная, куда будет помещено текущее время }

Time: TSystemTime;

{ Для анализа времени }

Hour, Minute, Second: String;

Begin

{ Получаем время }

GetLocalTime(Time);

{ Инициализируем переменные }

Hour := IntToStr(Time.wHour);

Minute := IntToStr(Time.wMinute);

Second := IntToStr(Time.wSecond);

{ Добавляем нули при необходимости }

If Length(Hour) = 1 Then Hour := '0' + Hour;

If Length(Minute) = 1 Then Minute := '0' + Minute;

If Length(Second) = 1 Then Second := '0' + Second;

{ Отображаем дату }

SetWindowText(HWnd, PChar(Hour + ':' + Minute + ':' + Second));

End;

{ Модифицированная оконная процедура поля ввода }

Function EditWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Begin

Case Msg Of

{ Запрещаем показ контекстного меню }

WM_CONTEXTMENU:

Begin

Result := 0;

MessageBeep(0);

Exit;

End;

End;

{ Не забываем вызвать оригинальную оконную процедуру }

Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),

Hwnd, Msg, WParam, LParam);

End;

{ Модифицированная оконная процедура кнопки }

Function BtnWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

Begin

Case Msg Of

{ При нажатии мыши запускаем таймер, интервал - 10 миллисекунд }

WM_LBUTTONDOWN: SetTimer(HWnd, BtnTimer, 10, @BtnTimerProc);

{ При отпускании мыши уничтожаем таймер }

WM_LBUTTONUP:

Begin

KillTimer(HWnd, BtnTimer);

{ Восстанавливаем прежний текст }

SetWindowText(HWnd, BtnText);

End;

End;

{ Не забываем вызвать оригинальную оконную процедуру }

Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),

HWnd, Msg, WParam, LParam);

End;

{ Оконная процедура главного окна }

Function MainWinProc(HWnd: THandle; Msg: Cardinal;

WParam, LParam: Integer): Cardinal; Stdcall;

{ Конвертирует сроку PChar в String }

Function StrPas(Const AStr: PChar): String;

Begin

Result := AStr;

End;

Begin

Case Msg Of

{ Здесь будет произведено создание дочерних окон }

WM_CREATE:

Begin

InfoStatic := CreateWindowEx(0, 'Static', StaticInfoText,

WS_CHILD Or WS_VISIBLE Or SS_LEFT,

8, 8, 270, 16, HWnd, 0, HInstance, NIL);

SetDefFont(InfoStatic);

Edit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', NIL,

WS_CHILD Or WS_VISIBLE Or ES_LEFT,

8, 28, 300, 21, HWnd, 0, HInstance, NIL);

SetDefFont(Edit);

{ Выделяем весь текст }

SendMessage(Edit, EM_SETSEL, 0, -1);

{ Далее делаем сабклассинг поля ввода }

SetWindowLong(Edit, GWL_USERDATA,

SetWindowLong(Edit, GWL_WNDPROC, LongInt(@EditWinProc)));

Btn := CreateWindowEx(0, 'Button', BtnText, WS_CHILD Or WS_VISIBLE

Or BS_PUSHBUTTON, 8, 52, 300, 25, HWnd, 0,

HInstance, NIL);

SetDefFont(Btn);

{ Далее делаем сабклассинг кнопки }

SetWindowLong(Btn, GWL_USERDATA,

SetWindowLong(Btn, GWL_WNDPROC, LongInt(@BtnWinProc)));

End;

WM_KEYDOWN:

{ Закрытие окна по нажатию Enter'а }

If WParam = VK_RETURN Then PostQuitMessage(0);

{Данное сообщение посылается при отрисовке Edit'a;

вы можете использовать переданный контекст для рисования

фона, либо для смены цвета текста; после завершения рисования

верните модифицированный контекст как результат сообщения и не

забудьте сделать выход из оконной процедуры, так как в противном

случае DefWindowProc снова разукрасит Edit в стандартный системный цвет }

WM_CTLCOLOREDIT:

Begin

{ Устанавливаем прозрачность фона }

SetBkMode(WParam, TRANSPARENT);

{ Устанавливаем цвет шрифта }

SetTextColor(WParam, $FF0000);

{ Возвращаем нужный нам контекст }

Result := WParam;

Exit;

End;

WM_DESTROY:

Begin

{ Выход для освобождения памяти }

PostQuitMessage(0);

End;

End;

{ Обработка всех остальных сообщений по умолчанию }

Result := DefWindowProc(HWnd, Msg, WParam, LParam);

End;

Procedure WinMain;

Var

Msg: TMsg;

{ Оконный класс }

WndClassEx: TWndClassEx;

Begin

{ Подготовка структуры класса окна }

ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

{************* Заполнение структуры нужными значениями ******************* }

{ Размер структуры }

WndClassEx.cbSize := SizeOf(TWndClassEx);

{ Имя класса окна }

WndClassEx.lpszClassName := 'SubclassSampleWnd';

{ Стиль класса, не окна }

WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;

{ Дескриптор программы (для доступа к сегменту данных) }

WndClassEx.hInstance := HInstance;

{ Адрес оконной процедуры }

WndClassEx.lpfnWndProc := @MainWinProc;

{ Иконки }

WndClassEx.hIcon := LoadIcon(HInstance, MakeIntResource('MAINICON'));

WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));

{ Курсор }

WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);

{ Кисть для заполнения фона }

WndClassEx.hbrBackground := COLOR_BTNFACE + 1;

{ Меню }

WndClassEx.lpszMenuName := NIL;

{ Регистрация оконного класса в Windows }

If RegisterClassEx(WndClassEx) = 0 Then

MessageBox(0, 'Невозможно зарегистрировать класс окна',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Создание окна по зарегистрированному классу }

HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,

'Subclassing Sample by Rrader', WS_OVERLAPPEDWINDOW And Not WS_BORDER

And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX,

Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,

HInstance, NIL);

If HWnd = 0 Then

MessageBox (0, 'Окно не создалось!',

'Ошибка', MB_OK Or MB_ICONHAND)

Else

Begin

{ Показ окна }

ShowWindow(HWnd, SW_SHOWNORMAL);

{ Обновление окна }

UpdateWindow(HWnd);

{ Цикл обработки сообщений }

While GetMessage(Msg, 0, 0, 0) Do

Begin

TranslateMessage(Msg);

DispatchMessage(Msg);

End;

{ Выход по прерыванию цикла }

Halt(Msg.WParam);

End;

End;

End;

Begin

InitCommonControls;

{ Создание окна }

WinMain;

End.
правда мусора много, но в основном обрати внимание на ***WinProc и SetWindowLong(***, GWL_USERDATA,

SetWindowLong(***, GWL_WNDPROC, LongInt(@***WinProc)));

Добавлено через 5 минут
На каллбэк.длл
там не таймер ;)
 
Последнее редактирование:

Avangard

Участник
DaRKdemoN,
library isLogo;

uses
Windows,
Messages,
GDIPAPI,
GDIPOBJ,
GDIPUTIL;

{$R *.res}

var
img: TGPImage;
graph: TGPGraphics;
graphp: Pointer;
p: TGPRectF;
Msg: Longint;
OldProc: Longint;

Function ImgWinProc(wnd: HWND; Msg, wParam, lParam: longint): Longint; Stdcall;
Begin
Result := CallWindowProc(Pointer(OldProc), wnd, Msg, wParam, lParam);
End;

procedure create_logo(wnd: HWND; FileName: PChar; X, Y, W, H: Integer) stdcall;
var
wParam, lParam: longint;
begin
OldProc:= SetWindowLong(wnd, GWL_WNDPROC, LongInt(@ImgWinProc));


case Msg Of
WM_PAINT:
Begin

img := TGPImage.Create(filename);

p.X:=x;
p.Y:=y;
p.Width:=w;
p.Height:=h;

graph := TGPGraphics.Create(getdc(wnd));
graph.DrawImage(img, p);
End;
End;
//SetWindowlong(wnd, GWL_WNDPROC, OldProc);
CallWindowProc(Pointer(GetWindowLong(Wnd, GWL_USERDATA)), Wnd, Msg, WParam, LParam);
UpdateWindow(wnd);
end;

procedure Free(); stdcall;
begin
img.Free;
graph.Free;
GdiplusShutdown(1);
end;

exports create_logo;
exports free;

begin
end.
не работает. Подскажи, что не так.
 

DaRKdemoN

Участник
Проверенный
library isLogo;

uses
Windows,
Messages,
GDIPAPI,
GDIPOBJ,
GDIPUTIL;

{$R *.res}

var
img: TGPImage;
graph: TGPGraphics;
graphp: Pointer;
p: TGPRectF;
Msg: Longint;
OldProc: Longint;

Function ImgWinProc(wnd: HWND; Msg, wParam, lParam: longint): Longint; Stdcall;
Begin
if Msg = WM_PAINT then Begin

img := TGPImage.Create(filename);

p.X:=x;
p.Y:=y;
p.Width:=w;
p.Height:=h;

graph := TGPGraphics.Create(getdc(wnd));
graph.DrawImage(img, p);
End;

Result := CallWindowProc(Pointer(OldProc), wnd, Msg, wParam, lParam);
End;

procedure create_logo(wnd: HWND; FileName: PChar; X, Y, W, H: Integer) stdcall;
begin
OldProc:= SetWindowLong(wnd, GWL_WNDPROC, LongInt(@ImgWinProc));
UpdateWindow(wnd);
end;

procedure Free(); stdcall;
begin
img.Free;
graph.Free;
GdiplusShutdown(1);
end;

exports create_logo;
exports free;

begin
end.
так попробуй
 

Avangard

Участник
DaRKdemoN, инсталл даже не запускается...

Ребята, мне нужно реализовать следующее: при вызове функции, будут копироваться файлы. Но, как сделать так чтобы эти файлы брались с библиотеки(ресурса)?
 
Последнее редактирование модератором:

Edison007

Ветеран
Модератор
народ есть у кого-нибудь исходник функции wrapcallback\wrapcallbackaddr используется в InnoCallBack.dll/CallBackCtrl.dll
 

Avangard

Участник
Как передать размер файла для загрузки в буфер?

Вот код:
function LibImgLoad(Wnd :HWND; buf :pAnsiChar; Size: Longint; Left, Top, Width, Height :integer; Stretch, IsBkg :boolean) :Longint; stdcall;
begin
try
DLLHandle := LoadLibrary ('botva2.dll');

if DLLHandle <> 0 then
begin
@ImgLoad := getProcAddress (DLLHandle, 'ImgLoad');
end;
if addr (ImgLoad) <> nil then
begin
ImgLoad(Wnd, buf, Left, Top, Width, Height, Stretch, IsBkg);
end;
finally end;
FreeLibrary (DLLHandle);
end;

Как скрыть процесс копирование, переименования, удаления файлов от таких программ, как ShFilesAcSpy?

Как можно разблокировать файл? Нашел функцию UnLockFile, но как с ней работать - не знаю.
 
Последнее редактирование модератором:

Shegorat

Lord of Madness
Администратор
Как передать размер файла для загрузки в буфер?
Вот код:
Тут никак. Функция ImgLoad загружает картинку из файла. Если ты хочешь загружать картинку из буфера то тебе нужно обращаться напрямую к GDI+ и вручную отрисовывать все картинки.
Как скрыть процесс копирование, переименования, удаления файлов от таких программ, как ShFilesAcSpy?
А зачем?
Как можно разблокировать файл?
Опять таки вопрос: зачем?
 

Avangard

Участник
Тут никак. Функция ImgLoad загружает картинку из файла. Если ты хочешь загружать картинку из буфера то тебе нужно обращаться напрямую к GDI+ и вручную отрисовывать все картинки.
Ясно...
Опять таки вопрос: зачем?
Для удаления файла, но он занят другой программной...
 

Krinkels

Он где то тут
Администратор
Для удаления файла, но он занят другой программной...
Хм, поведай нам, о гуру, что за файл, что за программа, и может кто нибудь тебе даст совет.

А вообще задавая глупый или неполный вопрос ты можешь получить такой же ответ.
 

Avangard

Участник
Как загрузить dll с ресурса?

Как загрузить файл с буфера, зная его размер? Видел где-то пример, но никак не могу найти...

Как получить размер файла, размер которого превышает 4 гига? TSearchRec не работает, если файл распаковывается, например, с архива.
 
Последнее редактирование модератором:

Avangard

Участник
Ne0N
Размер файла показывается не правильный. Код:
Код:
function FileSize2(FileName: PAnsiChar): Longword;
var FHandle: THandle;
begin
  FHandle:= CreateFile(PChar(FileName), GENERIC_READ, 0, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  FHandle:= GetFileSize(FHandle, nil);
end;
 
Статус
В этой теме нельзя размещать новые ответы.
Сверху