Как отловить сообщения о прокрутке TScrollBar

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Олег Кулабухов

Нижеприведенный пример передвигает второй ScrollBar на такое же количество едениц, на которое передвинет пользователь первый. Т.е. синхронизирует их.

type

{$IFDEF WIN32}

WParameter = LongInt;

{$ELSE}

WParameter = Word;

{$ENDIF}

LParameter = LongInt;

{Declare a variable to hold the window procedure we are replacing}

var

OldWindowProc: Pointer;

function NewWindowProc(WindowHandle: hWnd;

TheMessage: WParameter;

ParamW: WParameter;

ParamL: LParameter): LongInt

{$IFDEF WIN32} stdcall;

{$ELSE}; export;

{$ENDIF}

var

TheRangeMin: integer;

TheRangeMax: integer;

TheRange: integer;

begin

if TheMessage = WM_VSCROLL then

begin

{Get the min and max range of the horizontal scroll box}

GetScrollRange(WindowHandle,

SB_HORZ,

TheRangeMin,

TheRangeMax);

{Get the vertical scroll box position}

TheRange := GetScrollPos(WindowHandle,

SB_VERT);

{Make sure we wont exceed the range}

if TheRange < TheRangeMin then

TheRange := TheRangeMin

else if TheRange > TheRangeMax then

TheRange := TheRangeMax;

{Set the horizontal scroll bar}

SetScrollPos(WindowHandle,

SB_HORZ,

TheRange,

true);

end;

if TheMessage = WM_HSCROLL then

begin

{Get the min and max range of the horizontal scroll box}

GetScrollRange(WindowHandle,

SB_VERT,

TheRangeMin,

TheRangeMax);

{Get the horizontal scroll box position}

TheRange := GetScrollPos(WindowHandle,

SB_HORZ);

{Make sure we wont exceed the range}

if TheRange < TheRangeMin then

TheRange := TheRangeMin

else if TheRange > TheRangeMax then

TheRange := TheRangeMax;

{Set the vertical scroll bar}

SetScrollPos(WindowHandle,

SB_VERT,

TheRange,

true);

end;

{ Call the old Window procedure to }

{ allow processing of the message. }

NewWindowProc := CallWindowProc(OldWindowProc,

WindowHandle,

TheMessage,

ParamW,

ParamL);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

{ Set the new window procedure for the control }

{ and remember the old window procedure. }

OldWindowProc := Pointer(SetWindowLong(ScrollBox1.Handle,

GWL_WNDPROC,

LongInt(@NewWindowProc)));

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

{ Set the window procedure back }

{ to the old window procedure. }

SetWindowLong(ScrollBox1.Handle,

GWL_WNDPROC,

LongInt(OldWindowProc));

end;

{/codecitation}

Как отловить момент окончания изменения размеров компонента

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

В следующем примере показан перехват сообщения WM_EXITSIZEMOVE Хотя сообщение документированно только для Windows NT оно работает точно так же и под Windows 95. Обратите внимание что Вы можите перехватить сообщение WM_ENTERSIZEMOVEдля определения момента начала пользователем операции изменения размера или перемещения окна.

type

TForm1 = class(TForm)

private

{ Private declarations }

public

{ Public declarations }

procedure WMEXITSIZEMOVE(var message: TMessage); message WM_EXITSIZEMOVE;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMEXITSIZEMOVE(var message: TMessage);

begin

Form1.Caption := ‘Finished Moving and sizing’;

end;

{/codecitation}

Как обрабатывать сообщения

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Обработка сообщений означает, что приложение будет тем или иным образом реагировать на полученные от операционной системы сообщения. В стандартном приложении Windows обработка сообщений сосредотачивается в процедурах окна. Delphi, частично обрабатывая сообщения, упрощает работу программиста, позволяя вместо одной процедуры для обработки всех типов сообщений создавать независимые процедуры для обработки сообщений различных типов.

Все процедуры обработки сообщений должны отвечать следующим требованиям:

Процедура должна быть методом объекта

Процедуре должен передаваться один передаваемый по ссылке параметр, т.е. с помощью описания var. Тип параметра должен быть TMessage или другой, зависящий от типа специализированного сообщения

Описание процедуры должно включать ключевое слово message, за которым должна следовать константа, задающая тип обрабатываемого сообщения

Вот пример объявления процедуры, обрабатывающей сообщение WM_Paint

procedure WMPaint(var Msg: TWMPaint); message wm_Paint;

[соглашение по присвоению имён требует присваивать обработчику сообщения то же имя, что и имя обрабатываемого сообщения, но без символа подчёркивания и указанием первым знаков имени прописными буквами]

В качестве примера напишем процедуру обработки сообщения WM_Paint, которая вместо перерисовки будет выдавать звуковой сигнал:

Для этого сначала нужно объявить процедуру в частных объявлениях (в области Private объекта TForm1):

procedure WMPaint(var Msg: TWMPaint); message wm_Paint;

Теперь в разделе implementation модуля добавляем определение процедуры (в этом случае указание ключевого слова message не требуется):

procedure TForm1.WMPaint(var Msg: TWMPaint);

begin

beep;

inherited;

end;

Обратите внимание на ключевое слово inherited, которое позволяет передать сообщение обработчику этого сообщения, принадлежащему классу-предку, т.е. если бы мы в нашем случае не указали бы это слово, перерисовка окна не осуществлялась бы, а выполнялось бы только только то, что было описано в области реализации нашего приложения, т.е. только бы подавался звуковой сигнал.

{/codecitation}

Как обнаружить активность юзера

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Сынишка системного администратора вечером просит папу:

— Па. Почитай на ночь сказку про умного, толкового, доброго, смелого юзерa…

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;

{/codecitation}

Как запрограммировать Undo

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Встречаются два программиста — один идет веселый, пьет пиво, а второй — грустный, но с коляской. Первый:

— Ты чего такой? Жизнь прекрасна!

Второй (указывая на коляску):

— Да вот!.. Ни Uninstall, ни Undo не помогли

Memo1.Perform(EM_UNDO, 0, 0);

{/codecitation}

Занесение сообшения в EventLog (Windows NT)

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Alex V. Novikov

Черт гуляет по чистилищу. В 1-ю дверь заходит, там крики, кого-то плетью хлещут. Во 2-ю заходит, там кого-то в котле варят. Заходит в 3-ю, там сидит за компьютером какой-то мужичок, тишина, спокойствие. Черт в недоумении бежит к Дьяволу.

— Чего там за такое?

— А, это? Да это Билл Гейтс. Его приговили программы для «Линукса» писать!!!

Я постоянно читаю конференции по дельфи и частенько встечается вопрос как занести свое сообщение в EventLog Windows NT. Недавно покопавшись в исходниках VCL я обнаружил такой интересный класс:

Unit SvcMgr;

{—Skip—}

{ TEventLogger }

TEventLogger = class(TObject)

private

FName: String;

FEventLog: Integer;

public

constructor Create(Name: String);

destructor Destroy; override;

procedure LogMessage(Message: String; EventType: DWord = 1;

Category: Word = 0; ID: DWord = 0);

end;

{—Skip—}

С помощью этого класса можно легко заносить свои сообщения в EventLog, правда этот класс был замечен мною только в Delphi 5, на счет других версий я не уверен.

Пример использования:

with TEventLogger.Create(‘My Application’) do

try

LogMessage(‘Страшенная ошибка’);

finally

Free;

end;

P.S. надеюсь это кому нибудь поможет

{/codecitation}

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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: Алексей Еремеев

В своей работе мне частенько приходиться делать разного рода клиент-серверные системы.

И совсем не обязательно на уровне глобальных сетей. Речь пойдет о внутренних подсистемах.

Например, имеем компонент, который эмулирует секундомер. Запустили его с параметром типа «а напомни мне, что будет полночь» и забыли. Ну и конечно событие есть типа OnAlert. И обработчик его честно будет вызван по достижении нужной нам полуночи. Но обработчик один, а захотели узнать об этом событии сразу десять разных объектов. Не вешать же десять будильников?

Конечно, проще в одном обработчике перебрать методы уведомления этих десяти объектов да и дело с концом. Но можно поступить хитрее — заставить объект-будильник самому напоминать всем кто попросит его об этом. Вот о способах такого уведомления и пойдет речь.

Как условие — объект «сервер» ничего не знает об объекте «клиенте». После некоторого размышления и перебрав несколько вариантов я пришел к выводу, что наиболее приемлимые для практики есть два способа. Первый подсмотрен в WinAPI а второй — чисто Дельфи. Оба способа основаны на простой идее регистрации клиента на сервере и оповещении сервером клиентов по внутреннему списку зарегистрированных клиентов.

Способ 1. Оповещение через механизм сообщений Windows.

в модуле объекта-сервера в интерфейсной части определяется пользовательский номер события:

const

WM_NOTIFY_MSG = WM_USER 123;

в объекте-сервере реализуются две интерфейсные процедуры (вкупе с объявленным в приватной секции и созданным в конструкторе TList, в деструкторе не забудем его разрушить, естественно)

procedure RegisterHandle(HW: THandle);

var

i: integer;

begin

i := FWindList.IndexOf(pointer(HW));

if i < 0 then

FWinList.Add(pointer(HW));

end;

procedure UnregisterHandle(HW: THandle)

var

i: integer;

begin

i := FWindList.IndexOf(pointer(HW));

if i >= 0 then

FWinList.Delete(i);

end;

и создается функция оповещения в приватной секции:

procedure SendNotify(wParam, lParam: integer);

var

i: integer;

begin

i := 0;

while i < FWinList.Count do

begin

SendMessage(integer(FWinList.Items[i]), WM_NOTIFY_MSG, wParam, lParam);

Inc(i);

end;

end;

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

Объект-клиент должен иметь хэндл окна, который регистрируется на объекте-сервере и обработчик событий этого окна, который будет вызыватся при оповещении сервером списка клиентов (окон).

У объекта-клиента можно поступить двояко. Если объект-клиент уже имеет хэндл окна (например, форма) то пишется обработчик фиксированного номера события:

procedure ServMsg(var Msg: TMessage); message WM_NOTIFY_MSG;

или если окна нет, то создается универсальный метод-обработчик и невидимое окно при помощи функции AllocateHWND() (пример смотрите в исходниках VCL — объект TTimer)

Прелесть этого метода состоит в том, что объект-клиент может быть вообще в другом приложении, нежели объект-сервер, и такой трюк пройдет при использовании DLL. Кроме того передавать можно не только пару цифр, но и блоки данных (и даже строки) при помощи сообщения WM_COPYDATA.

Но это уже другая история, а мы пока пойдем дальше.

Способ 2. Оповещение через объект-посредник.

В отдельном модуле создаем объект-посредник, который имеет один метод типа SendEvent и одну ссылку на обработчик события OnEvent. Я назвал такой объект TSynaps (да простят меня нейрохирурги)

unit Synaps;

interface

uses

Windows, Messages, SysUtils, Classes;

type

TSynaps = class(TObject)

private

FOnEvent: TNotifyEvent;

public

procedure SendEvent;

property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;

end;

implementation

procedure SendEvent;

begin

if Assigned(FOnEvent) then

try

FOnEvent(Self);

except

end;

end;

end;

Причем методов и событий может быть много разных на любой вкус. С очередями, асинхронными «прослойками», задержками и другими наворотами. Тут уж кто на что горазд. Я лишь демонстрирую идею. Модуль с объектом-сервером и модуль с объектом-клиентом имеют право знать о модуле Synaps. В объекте-сервере реализуются уже знакомые нам три функции (чуть иначе):

в интерфейсе объекта:

procedure RegisterSynaps(Syn: TSynaps);

var

i: integer;

begin

i := FSynapsList.IndexOf(pointer(Syn));

if i < 0 then

FSynapsList.Add(pointer(Syn));

end;

procedure UnregisterSynaps(Syn: TSynaps);

var

i: integer;

begin

i := FSynapsList.IndexOf(pointer(Syn));

if i >= 0 then

FSynapsList.Delete(i);

end;

и приватная функция:

procedure NotifySynapses;

var

i: integer;

begin

i := 0;

while i < FSynapsList.Count do

begin

TSynaps(FSynapsList.Items[i]).SendEvent;

Inc(i);

end;

end;

Объект-клиент создает в себе объект-синапс, назначает его событию OnEvent свой внутренний обработчик и регистрирует этот синапс на объекте-сервере. Вуаля! И получает оттуда уведомления. Кстати, в деструктор синапса можно встроить вызов события OnDestroy, и тогда объект-сервер, при регистрации клиента, может назначить ему обработчик и автоматически разрегистрировать его при уничтожении. Но это уже навороты.

Такой подход позволяет строить обратные вызовы любой сложности. К тому-же это чистый паскаль-код без привязки к операционке. (а вдруг Kylix :о)

Итог.

Как вы могли заметить, оба способа базируются на двух базовых идеях. Первое — это регистрация клиента на сервере, и второе — вызов сервером некой функции внутри клиента. Разница только в механизмах. И выбирать тут можно исходя из вкусов, предпочтений и неких требований, связанных с ресурсоемкостью, переносимостью и т. п.

На самом деле есть очень широко распространенный и давно известный метод под названием CallBack-функция.

Мы вызываем кого-то и передаем как один из параметров адрес другой функции. И этот метод частенько используется в WinAPI (смотрите, к примеру, справку по функции EnumFonts). Но! Механизм прямого CallBack-а довольно некрасиво ложится на объектную модель Дельфи, так что я не стал описывать его здесь. Тем более, что оба способа — то-же самое, но красивше. И самое последнее — не забывайте разрегистрировать клиента в конце работы и освобождать ресурсы в деструкторе. И да известят вас ваши сервера только о хорошем!

{/codecitation}

Технология без интересного имени или как работать со сканером

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Павел

В настоящее время в конференциях то и дело встречаются вопросы типа: как мне получить изображение со сканера, с web камеры и т.д.. При том, что и интернете практически полностью отсутствуют материалы по этим вопросам на русском языке и при достаточном разнообразии их на английском. Эта статья должна помочь начинающему программисту на Delphi разобраться в них. В статье подробно, с примерами описана работа со сканером с использованием популярной библиотеки Easy TWAIN.

Введение

В отличие от принтеров сканеры изначально не поддерживались ОС Windows и не имеют API для работы с ними. В начале своего появления сканеры взаимодействовали с программами посредством уникального для каждой модели сканера интерфейса, что серьезно затрудняло включение поддержки работы со сканером в прикладные программы.

Для решения этой проблемы был разработан TWAIN — индустриальный стандарт интерфейса программного обеспечения для передачи изображений из различных устройств в Windows и Macintosh. Стандарт издан и поддерживается TWAIN рабочей группой — официальный сайт www.twain.org. Стандарт издан в 1992 г. В настоящее время действует версия 1.9 от января 2000 г. Абревеатура TWAIN изначально не имела какого-то определенного смысла хотя позже была придумана расшифровка: (Technology Without An Interesting Name — Технология без интересного имени). TWAIN — не протокол аппаратного уровня, он требует драйвера (названного Data Source или DS) для каждого устройства.

К настоящему времени (май 2000 г.) TWAIN доступен для Windows 3.1 и выше (Intel и совместимые процессоры), Macintosh и OS/2. Для Linux самый близкий стандарт — SANE.

Менеджер TWAIN (DSM) — действует как координатор между приложениями и Источником Данных (Data Source). DSM имеет минимальный пользовательский интерфейс — только выбор DS. Все взаимодействие с пользователем вне прикладной программы осуществляется по средствам DS.

Каждый источник данных разрабатывается непосредственно производителем соответствующих устройств. И их поддержка стандарта TWAIN осуществляется на добровольной основе.

Использование TWAIN

DSM и DS это DLLs загружаемые в адресное пространство приложения и работают как подпрограммы приложения. DSM использует межпроцесcную связь, что бы координировать действия со своими копиями, когда больше чем одна программа использует TWAIN.

Упрощенная схема действия приложения использующего TWAIN:

Открыть диалог настройки соответствующего устройства (диалог отображает DS) и задать соответствующие настройки.

Приложение ожидает сообщение от DS, что изображение готово. Во время ожидания все зарегистрированные сообщения будут направляться через TWAIN. Если это не будет выполняться, то приложение не получит сообщения о готовности изображения.

Приложение принимает изображение от DS.

TWAIN определяет три типа передачи изображения:

Native — в Windows это DIB в памяти

Memory — как блоки пикселей в буферах памяти

File — DS записывает изображение непосредственно в файл (не обязательно поддерживается)

Приложение закрывает DS.

Использование EZTWAIN

Данная библиотека была разработана, что бы упростить разработку программ использующих TWAIN предоставляя разработчику упрощенную версию TWAIN API.

EZTWAN обеспечивает передачу всех windows сообщений через TWAIN и ожидает сообщения о готовности изображения.

Библиотека EZTWAIN является свободно распространяемой библиотекой с открытыми исходными кодами. В настоящее время выпущена версия 1.12. Библиотеку можно свободно скачать с сайта: www.dosadi.com, библиотека написана на C и предназначена для использования как DLL, необходимый для ее использования с Delphi модуль так же можно скачать с сайта. Кроме нее у меня с сайта можно скачать модификацию данной библиотеки, предназначенную для статической компоновки с программой на Delphi. Указанная версия (MultiTWAIN for Delphi) не требует наличия библиотеки EZTW32.DLL.

Структура программы

Используемые функции.

Перед вызовом функций сканирования необходимо вызвать функцию:

TWAIN_SelectImageSource(hwnd: HWND): Integer;

Данная функция позволяет выбрать источник получения данных из списка TWAIN совместимых устройств, в качестве параметра она получает хендл основного окна прикладной программы. Следует заменить, что если в системе имеется одно TWAIN совместимое устройство, то вызывать функцию не обязательно.

Для получения изображения служит функция:

TWAIN_AcquireNative(hwnd: HWND; pixmask: Integer): HBitmap;

где:

hwnd — хендел основного окна прикладной программы (допускается указывать 0);

pixmask — режим сканирования ( необходимо задавать 0 — указание другого режима может приводить к ошибке);

hBitmap — указатель на область памяти, содержащей полученные данные в DIB формате.

По окончании работы с DIB данными их необходимо удалить вызвав процедуру:

TWAIN_FreeNative(hDIB: HBitmap);

где:

hDIB — указатель, полученный при вызове функции TWAIN_AcquireNative.

Для облегчения обработки полученных DIB данных в библиотеке имеется несколько сервисных функций:

TWAIN_DibWidth(hDib: HBitmap): Integer;

// Получает ширину изображения в пикселях

TWAIN_DibHeight(hDib: HBitmap): Integer;

// Получает высоту изображения в пикселях

TWAIN_CreateDibPalette(hdib: HBitmap): Integer;

// Получает цветовую палитру изображения

TWAIN_DrawDibToDC(hDC: HDC;

dx, dy, w, h: Integer;

hDib: HBitmap;

sx, sy: Integer);

// Передает DIB данные в формате совместимым

// с указанным контекстом устройства.

Пример программы

Полный текст примера можно взять отсюда. Мы рассмотрим только функцию получения данных с TWAIN устройства:

procedure TForm1.Accquire1Click(Sender: TObject);

var

dat: hBitMap;

PInfo: PBitMapInfoHeader;

Height, Width: integer;

{Функция возведения 2 в степень s}

function stp2(s: byte): longint;

var

m: longint;

i: byte;

begin

m := 2;

for i := 2 to s do

m := m * 2;

stp2 := m;

end;

begin

{Получаем указатель на графические данные}

dat := TWAIN_AcquireNative(Handle, 0);

if dat 0 then

begin

{Получаем указатель на область памяти содержащей DIB

данные и блокируем область памяти}

PInfo := GlobalLock(dat);

{Анализируем полученные данные}

Height := PInfo.biHeight;

Width := PInfo.biWidth;

{Узнаем размер полученного изображения в сантиметрах}

Wcm.Caption := floatToStrF(100 / PInfo.biXPelsPerMeter * Width, ffNumber, 8,

3)

‘ cm’;

Hcm.Caption := floatToStrF(100 / PInfo.biYPelsPerMeter * Height, ffNumber,

8, 3)

‘ cm’;

{Определяем число цветов в изображении}

Colors.Caption := floatToStrF(stp2(PInfo.biBitCount), ffNumber, 8, 0)

‘ цветов’;

{Разблокируем память}

GlobalUnlock(dat);

{Передаем в битовую матрицу графические данные}

{И устанавливаем перехват ошибок}

try

MyBitMap.Palette := TWAIN_CreateDibPalette(dat);

MyBitMap.Width := Width;

MyBitMap.Height := Height;

TWAIN_DrawDibToDC(MyBitMap.Canvas.Handle, 0, 0, Width, Height, dat, 0, 0);

except

// Обрабатываем наиболее вероятную ошибку связанную

// с не хваткой ресурсов для загрузки изображения

on EOutOFResources do

MessageDlg(‘TBitMap: Нет ресурсов для загрузки изображения!’,

mtError, [mbOk], 0);

end;

{Отображаем графические данные}

Image1.Picture.Graphic := MyBitMap;

{Освобождаем память занятую графическими данными}

TWAIN_FreeNative(dat);

end;

end;

Обработка ошибок необходима, так как объект TBitMap имеет серьезные ограничения на размер создаваемого изображения. При этом производится обработка наиболее вероятной ошибки, в случае возникновения другой ошибки, ее обработка будет передана обработчику по умолчанию. Обработка ошибки в данном случае заключается в выдаче диагностического сообщения, в прикладной программе можно реализовать выполнение любых необходимых действий, например, произвести уменьшение разрешения и повторно подать на загрузку в TBitMap.

Заключение

Приведенный здесь пример тестировался на сканере Umax 2000P с драйвером VistaScan32 V3.52. При получении изображений следует помнить, что максимальный размер блока памяти, который может распределить Windows, составляет 2 Гб и при попытке сканировании страниц формата А4 с высоким разрешением можно превысить этот предел. Кроме того, достаточно простой в обращении объект TBitMap имеет куда более серьезные ограничения на размер загружаемых изображений, что требует непосредственной работы с DIB данными. Но это уже тема для отдельной статьи. Если у Вас появились вопросы или предложения пишите мне: speclab@4unet.ru

{/codecitation}

Сканирование изображений

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

The setup program for Imaging (tool that ships with Windows > 98) installs the Image

Scan control (OCX) and the 32-bit TWAIN DLLs.

All you have to do is to import this ActiveX control in Delphi and generate a component wrapper:

Import the ActiveX Control «Kodak Image Scan Control»

(Select Component|Import ActiveX Control…)

Now add a TImgScan Component from the Register «ActiveX» to your form.

Change the following Properties in the Object Inspector:

FileType = 3 — BMP_Bitmap

PageOption = 4 — OverwritePages

ScanTo = 2 — FileOnly

{***}

Das Setup Programm fьr Imaging (Ist bei Windows > 98 dabei) installiert das Bild Scanning Control (OCX) und die 32-bit TWAIN DLLs.

Importiere das ActiveX-Control «Steuerung fьr Kodak-Bildscan».

(Im Menь Komponente, «ActiveX importieren» anklicken.)

Dann «Steuerung fьr Kodak-Bildscan…» auswдhlen und den «Installieren…» Button anklicken.

Fьge nun eine «TImgScan» Komponente aus dem Register «ActiveX» auf dem Formular ein.

Дndere im Objektinspektor unter «ImgScan1» folgende Eigenschaften:

FileType = 3 — BMP_Bitmap

PageOption = 4 — OverwritePages

ScanTo = 2 — FileOnly

{***}

procedure TForm1.Button1Click(Sender: TObject);

begin

if imgScan1.ScannerAvailable then

try

imgScan1.Image := ‘c:\Scanner.bmp’;

imgScan1.OpenScanner;

imgScan1.Zoom := 100;

imgScan1.StartScan;

Application.ProcessMessages;

finally

imgScan1.CloseScanner;

{ Show the scanned image in Image1 }

imgScan1.Picture.LoadFromFile(Image1.Image);

end;

end;

{/codecitation}

Экспортировать ветвь реестра

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

unit RegExpo;

interface

uses

Windows, rRegistry, Classes, SysUtils;

{$I-}

{$LONGSTRINGS ON}

{

Regexpo

Author : Arthur Hoornweg (arthur.hoornweg@email.de)

Version : 1.00, May 1998

O/S : Windows 95, 98, ME, NT, 2000, XP

Delphi 2

Function :

This unit allows you to backup a branch of the registry into a *.REG file,

that is compatible with «regedit».

Double-clicking such a file in the explorer will import it.

Example:

ExportRegistryBranch(HKEY_LOCAL_MACHINE,’SOFTWARE\Borland\Delphi’,’A:\DELPHI.REG’)

(c) 1998 A.M. Hoornweg. All rights reserved.

You may use this software for all purposes, both commercial and

noncommercial, as long as proper credit is given. The sourcecode may be distributed

freely, as long as this copyright is included and no more than a marginal fee is

asked.

Disclaimer:

I accept no responsibility whatsoever for any damages caused by these

routines. Use them at your own risk. If you find any bugs, please let me know.

}

procedure ExportRegistryBranch(Rootsection: Integer; regroot: string;

FileName: string);

implementation

function dblBackSlash(t: string): string;

var

k: longint;

begin

Result := t; {Strings are not allowed to have}

for k := Length(t) downto 1 do {single backslashes}

if Result[k] = ‘\’ then Insert(‘\’, Result, k);

end;

procedure ExportRegistryBranch(rootsection: Integer; Regroot: string;

FileName: string);

var

reg: TRegistry;

f: Textfile;

p: PChar;

procedure ProcessBranch(root: string); {recursive sub-procedure}

var

values, keys: TStringList;

i, j, k: longint;

s, t: string; {longstrings are on the heap, not on the stack!}

begin

Writeln(f); {write blank line}

case rootsection of

HKEY_CLASSES_ROOT: s := ‘HKEY_CLASSES_ROOT’;

HKEY_CURRENT_USER: s := ‘HKEY_CURRENT_USER’;

HKEY_LOCAL_MACHINE: s := ‘HKEY_LOCAL_MACHINE’;

HKEY_USERS: s := ‘HKEY_USERS’;

HKEY_PERFORMANCE_DATA: s := ‘HKEY_PERFORMANCE_DATA’;

HKEY_CURRENT_CONFIG: s := ‘HKEY_CURRENT_CONFIG’;

HKEY_DYN_DATA: s := ‘HKEY_DYN_DATA’;

end;

Writeln(f, ‘[‘ s ‘\’ root ‘]’); {write section name in brackets}

reg.OpenKey(root, False);

try

values := TStringList.Create;

try

keys := TStringList.Create;

try

reg.GetValuenames(values); {get all value names}

reg.GetKeynames(keys); {get all sub-branches}

for i := 0 to values.Count — 1 do {write all the values first}

begin

s := values[i];

t := s; {s=value name}

if s = » then s := ‘@’ {empty means «default value», write as @}

else

s := ‘»‘ s ‘»‘; {else put in quotes}

Write(f, dblbackslash(s) ‘=’); {write the name of the key to the file}

case reg.Getdatatype(t) of {What type of data is it?}

rdString, rdExpandString: {String-type}

Writeln(f, ‘»‘ dblbackslash(reg.ReadString(t) ‘»‘));

rdInteger: {32-bit unsigned long integer}

Writeln(f, ‘dword:’ IntToHex(reg.readinteger(t), 8));

{write an array of hex bytes if data is «binary.» Perform a line feed

after approx. 25 numbers so the line length stays within limits}

rdBinary:

begin

Write(f, ‘hex:’);

j := reg.GetDataSize(t); {determine size}

GetMem(p, j); {Allocate memory}

reg.ReadBinaryData(t, p^, J); {read in the data, treat as pchar}

for k := 0 to j — 1 do

begin

Write(f, IntToHex(Byte(p[k]), 2)); {Write byte as hex}

if k j — 1 then {not yet last byte?}

begin

Write(f, ‘,’); {then write Comma}

if (k > 0) and ((k mod 25) = 0) {line too long?} then

Writeln(f, ‘\’); {then write Backslash lf}

end; {if}

end; {for}

FreeMem(p, j); {free the memory}

Writeln(f); {Linefeed}

end;

else

Writeln(f, ‘»»‘); {write an empty string if datatype illegal/unknown}

end;{case}

end; {for}

finally

reg.CloseKey;

end;

finally

{value names all done, no longer needed}

values.Free;

end;

{Now al values are written, we process all subkeys}

{Perform this process RECURSIVELY…}

for i := 0 to keys.Count — 1 do

ProcessBranch(root ‘\’ keys[i]);

finally

keys.Free; {this branch is ready}

end;

end; { ProcessBranch}

begin

if RegRoot[Length(Regroot)] = ‘\’ then {No trailing backslash}

SetLength(regroot, Length(Regroot) — 1);

Assignfile(f, FileName); {create a text file}

Rewrite(f);

if ioResult 0 then Exit;

Writeln(f, ‘REGEDIT4’); {«magic key» for regedit}

reg := TRegistry.Create;

try

reg.Rootkey := Rootsection;

{Call the function that writes the branch and all subbranches}

ProcessBranch(Regroot);

finally

reg.Free; {ready}

Close(f);

end;

end;

end.

{/codecitation}