Конвертируем TIF в PDF

Совместимость: Delphi 5.x (или выше)

Как-то раз получился TIF файл на несколько страниц и возникла необходимость конвертации его в PDF формат. Для использования такой возможности необходимо иметь полную версию Adobe Acrobat. Функция тестировалась на Adobe Acrobat 4.0.

Сперва Вам необходимо импортировать элементы управления Acrobat AxtiveX.

1) Выберите Component -> Import ActiveX Control
2) Выберите Acrobat Control for ActiveX и нажмите install
3) Выберите пакет ActiveX control для инсталяции
4) Добавьте PDFlib_tlb в Ваш проект. Этот файл находится в директории Borland\Delphi5\Imports.

Как использовать функцию

Вот пример её вызова:

if not TifToPDF('c:\test.tif', 'c:\test.pdf') then Showmessage('Could not convert');

Функция TifToPdf

function TifToPDF(TIFFilename, PDFFilename: string): boolean;
var
AcroApp : variant;
AVDoc : variant;
PDDoc : variant;
IsSuccess : Boolean;
begin
result := false;
if not fileexists(TIFFilename) then exit;

try
AcroApp := CreateOleObject('AcroExch.App');
AVDoc := CreateOleObject('AcroExch.AVDoc');

AVDoc.Open(TIFFilename, '');
AVDoc := AcroApp.GetActiveDoc;

if AVDoc.IsValid then
begin
PDDoc := AVDoc.GetPDDoc;

PDDoc.SetInfo ('Title', '');
PDDoc.SetInfo ('Author', '');
PDDoc.SetInfo ('Subject', '');
PDDoc.SetInfo ('Keywords', '');

result := PDDoc.Save(1 or 4 or 32, PDFFilename);

PDDoc.Close;
end;

AVDoc.Close(True);
AcroApp.Exit;

finally
VarClear(PDDoc);
VarClear(AVDoc);
VarClear(AcroApp);
end;
end;

Создаём иконку из bitmap'a.

Вам необходимо создать два битмапа, битмап маски (назовём его "AND" bitmap) и битмап изображения (назовём его XOR bitmap). Вы можете пропустить обработчики для "AND" и "XOR" битмапов в Windows API функции CreateIconIndirect() и использовать обработчик возвращённой иконки в Вашем приложении.

procedure TForm1.Button1Click(Sender: TObject);
var
IconSizeX : integer;
IconSizeY : integer;
AndMask : TBitmap;
XOrMask : TBitmap;
IconInfo : TIconInfo;
Icon : TIcon;
begin
{Получаем размер иконки}
IconSizeX := GetSystemMetrics(SM_CXICON);
IconSizeY := GetSystemMetrics(SM_CYICON);

{Создаём маску "And"}
AndMask := TBitmap.Create;
AndMask.Monochrome := true;
AndMask.Width := IconSizeX;
AndMask.Height := IconSizeY;

{Рисуем на маске "And"}
AndMask.Canvas.Brush.Color := clWhite;
AndMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
AndMask.Canvas.Brush.Color := clBlack;
AndMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);

{Рисуем для теста}
Form1.Canvas.Draw(IconSizeX * 2, IconSizeY, AndMask);

{Создаём маску "XOr"}
XOrMask := TBitmap.Create;
XOrMask.Width := IconSizeX;
XOrMask.Height := IconSizeY;

{Рисуем на маске "XOr"}
XOrMask.Canvas.Brush.Color := ClBlack;
XOrMask.Canvas.FillRect(Rect(0, 0, IconSizeX, IconSizeY));
XOrMask.Canvas.Pen.Color := clRed;
XOrMask.Canvas.Brush.Color := clRed;
XOrMask.Canvas.Ellipse(4, 4, IconSizeX - 4, IconSizeY - 4);

{Рисуем в качестве теста}
Form1.Canvas.Draw(IconSizeX * 4, IconSizeY, XOrMask);

{Создаём иконку}
Icon := TIcon.Create;
IconInfo.fIcon := true;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := AndMask.Handle;
IconInfo.hbmColor := XOrMask.Handle;
Icon.Handle := CreateIconIndirect(IconInfo);

{Уничтожаем временные битмапы}
AndMask.Free;
XOrMask.Free;

{Рисуем в качестве теста}
Form1.Canvas.Draw(IconSizeX * 6, IconSizeY, Icon);

{Объявляем иконку в качестве иконки приложения}
Application.Icon := Icon;

{генерируем перерисовку}
InvalidateRect(Application.Handle, nil, true);

{Освобождаем иконку}
Icon.Free;
end;

Пример работы чтения и сохранении wav-файлов

Сразу оговорюсь, что рассматривать я буду только PCM формат - самый простой. Wav-файл состоит из заголовка и собственно информации. В заголовке находится информация о типе файла, частоте, каналах и т.д. Сама информация состоит из массива чисел по 8 или 16 бит. Если в файле 2 канала, то значения левого и правого каналов записываются поочередно.
Для работы с заголовком удобнее всего использовать запись, расположение полей в которой будет повторять расположение информации в файле. Например, первая запись в wav-файле - это символы "RIFF". Соответственно, первое поле в записи должно быть массивом из четырех элементов типа char. Вторая запись - длина файла без 8 байт (без первых двух записей). Длина записана в четырех байтах целым числом. Поэтому взят тип longint. Так составляется эта запись. Когда нужно целое число длиной 2 байта - берется smallint.
О создании wav-файлов и хранении самой информации я расскажу в следующем выпуске.
Эта программа выводит в Memo длину wav-файла, количество каналов, частоту и количество бит на запись.
Скачать необходимые для компиляции файлы проекта можно на program.dax.ru.

type
TWaveHeader = record
idRiff: array [0..3] of char;
RiffLen: longint;
idWave: array [0..3] of char;
idFmt: array [0..3] of char;
InfoLen: longint;
WaveType: smallint;
Ch: smallint;

Freq: longint;
BytesPerSec: longint;
align: smallint;

Bits: smallint;
end;

TDataHeader = record
idData: array [0..3] of char;
DataLen: longint;
end;
// Процедура чтения заголовка wav-файлов

procedure ReadWaveHeader(Stream: TStream;
var SampleCount, SamplesPerSec: integer;
var BitsPerSample, Channeles: smallint);
var
WaveHeader: TWaveHeader;
DataHeader: TDataHeader;
begin
Stream.Read(WaveHeader, sizeof(TWaveHeader));
with WaveHeader do
begin
if idRiff <> 'RIFF' then raise EReadError.Create('Wrong idRIFF');
if idWave <> 'WAVE' then raise EReadError.Create('Wrong idWAVE');
if idFmt <> 'fmt ' then raise EReadError.Create('Wrong idFmt');
if WaveType <> 1 then raise EReadError.Create('Unknown format');
Channeles := Ch;
SamplesPerSec := Freq;
BitsPerSample := Bits;
Stream.Seek(InfoLen - 16, soFromCurrent);
end;

Stream.Read(DataHeader, sizeof(TDataHeader));
if DataHeader.idData = 'fact' then

begin
Stream.Seek(4, soFromCurrent);
Stream.Read(DataHeader, sizeof(TDataHeader));
end;
with DataHeader do
begin
if idData <> 'data' then raise EReadError.Create('Wrong idData');
SampleCount := DataLen div (Channeles * BitsPerSample div 8) ;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
OpenDialog1.Filter := 'Wave files|*.wav';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
F: TFileStream;

SampleCount, SamplesPerSec: integer;

BitsPerSample, Channeles: smallint;

begin
// Вызов OpenDialog1:

if not OpenDialog1.Execute then Exit;
try
// Открытие файла:

F := TFileStream.Create(OpenDialog1.FileName, fmOpenRead);

// Чтение заголовка:
ReadWaveHeader(F, SampleCount, SamplesPerSec,
BitsPerSample, Channeles);
F.Free;
Memo1.Clear;
// Заполнение Memo информацией о файле:
Memo1.Lines.Add('SampleCount: ' + IntToStr(SampleCount));
Memo1.Lines.Add(Format('Length: %5.3f sec', [SampleCount / SamplesPerSec]));
Memo1.Lines.Add('Channeles: ' + IntToStr(Channeles));
Memo1.Lines.Add('Freq: ' + IntToStr(SamplesPerSec));
Memo1.Lines.Add('Bits: ' + IntToStr(BitsPerSample));
except
raise Exception.Create('Problems with file reading');
end;
end;

Вопрос # 22 от Юрий Васильев

Подскажите, please, как скрыть приложение на панели задач и упрятать
значок в трэй? Спасибо заранее.
С уважением, NoN

Отвечает santi@tut.by

Вoт полный код для RxTrayIcon из библиотеки RxLib!!!:::

procedure TForm1.RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Application.Restore;
SetForeGroundWindow(Application.MainForm.Handle);
RxTrayIcon1.Hide;
end;



procedure TForm1.ApplicationMinimize(Sender: TObject);
begin
RxTrayIcon1.Show;
ShowWindow(Application.Handle, SW_HIDE);
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMinimize := ApplicationMinimize;
end;

Вопрос #24 от Мельникова Алёна

Всем привет!

У меня такой вопрос: как сделать в Delphi, чтобы работал мышинный скроллинг? Т.е. у меня длинный-длинный СкроллБох, но мышинный скроллинг не прокручивается и приходится мышкой тащить по старинке скроллбар, что очень неудобно :(
Помогите, пожалуйста!

С уважением, ко всем профи Аленка :)

Отвечает Кама

У СколлБокса нужно обрабатывать событие OnMouseWheel/Up/Down.

Отвечает Sergey Larin

Скроллинг с помощью колесика должен автоматически рабоать в Windows 98 и
выше. В Win95 надо использовать специальную программу (мышиный драйвер). А
вообще это делается на уровне конкретной систему и программирования при
написании программы не трубует.

Вопрос #25 от wpost

Hi. Возможно ли в Delphi динамическое описание типа? Например:
Есть программа, которая вызывает процедуру file(name,size) Где name -
имя файла, а Size - размер в байтах.

Procedure file(var name:String,size:longint);
Type fill = array[1..Size] of byte;
^^^^^^^^^^
Var f: file of fill;
N: Fill;
begin
Assignfile(f,name); Reset(F); Read(f,N); CloseFile(F);

....
end;

Как это можно сделать? Если можно. Идея заключена в том, что любой
заранее неизвестный файл надо прочитать в память в виде массива за
ОДИН проход. Т.е. Разом весь, а не по байтам.
Заранее благодарен.
Aleksey.

Отвечает Кама

Исп. динамический массив:

var
fill: array of byte;

begin
...
SetLength(fill, size);
....

Отвечает Евдокимов Сергей

С помощью этого куска кода можно отмапить файл в память и работать с
ним как с массивом (p^[0] 1й байт) и т. д. Не нужно что то читать из
файла. Насчет записи не знаю скорее всего должно работать.

h1:=CreateFile(FileName,GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0);
h2:=CreateFileMapping(h1,nil,PAGE_READONLY,0,0,nil);
p:=MapViewOfFile(h2,File_map_read,0,0,0);
...
CloseHandle(h2);
CloseHandle(h1);
UnmapViewOfFile(p);

Отвечает cruel@xaker.ru

В 5-ой (кажется) версии Delphi появились динамические массивы...
Их задание:
A: array of Integer;
Дальше изменяешь его длину вызовом
SetLength(A,size);
Дополнительную инфу можешь посмотреть в справке Delphi, там всё, что
нужно для этого, есть...

Отвечает Sergey Larin

См. описание процедуры BlockRead в справочной системе. Одним из параметров
процедуры должна быть длина файла (соответственно под массив должна быть
отведена память в достаточном количестве).

Отвечает Sergey K

Здравствуйте.
К сожаленью у меня сейчас нет под рукой Делфи:(, пишу по памяти:

Procedure file(var name:String,size:longint);
Type fill = array[] of byte; // Пустые скобки
^^^^
Var f: file of fill;
N: Fill;
begin
SizeOf(fill,size); // SizeOf задает размер динамического масива. См. HELP
^^^^^^^^^^^^
Assignfile(f,name); Reset(F); Read(f,N); CloseFile(F);
....
end;

С уважением,
Сергей К,
SergeyK@bk.ru

Вопрос #26 от Антон Зайцев

Здравствуйте! Есть вопрос по поводу установки ловушек:
Для установки использую SetWindowsHookEx(WH_CBT, @hook1, hInstance, 0)
Ловушка срабатывает следующим образом:

if (c0de = HCBT_SETFOCUS) or (c0de = HCBT_MOVESIZE) or (c0de = HCBT_MINMAX) then
begin
hw := FindWindow('TfMain', 'This form getting messages from dll');
SendMessage(hw, WM_SOMETHING_HAPPEND, wParam, lParam);
CallNextHookEx(H, c0de, wParam, lParam); //function passes the hook information to the next hook procedure in
the current hook chain
end

Срабатывает нормально только HCBT_SETFOCUS, а HCBT_MOVESIZE и
HCBT_MINMAX отлавливают момент до перемещения и измененеия размеров
окна, а не после. Проводя аналогию, отлавливается onCanResize, а надо
поймать onResize. Может кто-нибудь знает ответ?

ОТВЕТИТЬ

Вопрос #27 от Даниил

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

ОТВЕТИТЬ

Вопрос #28 от Boris

Как взять данные с микрофона и направить в COM порт(модем) , как взять данные с COM порта (модема) и направить (проиграть) на динамике через звуковую карту.
(хочу написать программу PC-to-phone для компьютера с внутренним модемом)
Boris.

ОТВЕТИТЬ

Вопрос #29 от p_kolya

Hi, Программеры!
Вопросик есть...
Что такое ping и как он работает?
Подскажите работающий пример на делфях.

ОТВЕТИТЬ

Вопрос #30 от Oleg666

Привет всем,

У кого-нибудь есть алгоритм перекодировки символов из TMemo в Koi8-r,ОЧЕНЬ НУЖНО!!!

ОТВЕТИТЬ