Технология преобразования общих форматов изображений Delphi (2)
Автор:lyboy99
электронная почта:[email protected]
URL: http://hnh.126.com
Предоставить вам несколько часто используемых методов преобразования форматов изображений и их функции преобразования.
Надеюсь, это поможет вам
1. Конвертируйте TxT в GIF
2. Конвертируйте формат WMF в формат BMP.
3. Конвертируйте формат BMP в формат WMF.
4.Tbitmaps в регионы Windows
-------------------------------------------------- --------------------------
TxT в GIF
-------------------------------------------------- ------
PROcedure TxtToGif (txt, FileName: String);
вар
температура: TBitmap;
GIF: TGIFImage;
начинать
temp:=TBitmap.Create;
пытаться
темп.Высота:=400;
темп.Ширина:=60;
temp.Transparent:=True;
temp.Canvas.Brush.Color:=colFondo.ColorValue;
temp.Canvas.Font.Name:=Fuente.FontName;
temp.Canvas.Font.Color:=colFuente.ColorValue;
temp.Canvas.TextOut(10,10,txt);
Imagen.Picture.Assign(ноль);
GIF := TGIFImage.Create;
пытаться
GIF.Назначить(Темп);
//Сохранить GIF
GIF.SaveToFile(ИмяФайла);
Imagen.Picture.Assign (GIF);
окончательно
GIF.Бесплатно;
конец;
Окончательно
темп.Уничтожить;
Конец;
конец;
-------------------------------------------------- -------------------
2. Конвертируйте формат WMF в формат BMP.
-------------------------------------------------- ------------------
процедура WmfToBmp (FicheroWmf, FicheroBmp: строка);
вар
Метафайл: ТМетафайл;
Bmp:TBitmap;
начинать
Метафайл:=TMetaFile.create;
{Создать временное растровое изображение}
Bmp:=TBitmap.create;
{Загрузить метафайл}
МетаФайл.ЗагрузкаИзФайла(FicheroWmf);
{Нарисуйте метафайл на холсте Bitmap}
с BMP сделать
начинать
Высота:=Метафайл.Высота;
Ширина:=Метафайл.Ширина;
Canvas.Draw(0,0,Метафайл);
{Сохраните BMP}
SaveToFile(FicheroBmp);
{Бесплатная БМП}
Бесплатно;
конец;
{Бесплатный метафайл}
МетаФайл.Бесплатно;
конец;
-------------------------------------------------- -------------------
3. Конвертируйте формат BMP в формат WMF.
-------------------------------------------------- -------------------
процедура BmpToWmf (BmpFile,WmfFile:строка);
вар
Метафайл: TMetaFile;
Мфканвас: Тметафилеканвас;
BMP: TBitmap;
начинать
{Создать временные параметры}
МетаФайл := TMetaFile.Create;
BMP:= TBitmap.create;
BMP.LoadFromFile(BmpFile);
{Игуалемос тамаос}
{Выравнивание размеров}
МетаФайл.Высота := BMP.Высота;
МетаФайл.Ширина := BMP.Ширина;
{Создайте основу для метафайла}
MFCanvas:=TMetafileCanvas.Create(MetaFile, 0);
с MFCanvas сделать
начинать
{Нарисуйте BMP на холсте}
Нарисовать(0, 0, BMP);
{Освободите холст}
Бесплатно;
конец;
{Освободите БМП}
БМП.Бесплатно;
с MetaFile сделать
начинать
{Сохраните метафайл}
СохранитьToFile(WmfFile);
{Освободите это...}
Бесплатно;
конец;
конец;
-------------------------------------------------- -------------------
4.Tbitmaps в регионы Windows
-------------------------------------------------- -------------------
функция BitmapToRegion (bmp: TBitmap; TransparentColor: TColor=clBlack;
RedTol: Байт=1); GreenTol: Байт=1; BlueTol: Байт=1): HRGN;
константа
АллокЕдиница = 100;
тип
PRectArray = ^TRectArray;
TRectArray = Array[0..(MaxInt div SizeOf(TRect))-1] из TRect;
вар
пр: PRectArray;
ч:HRGN;
РгнДанные: PRгнДанные;
lr, lg, lb, hr, hg, hb: Байт;
х, у, х0: целое число;
б: PByteArray;
СканЛинеПтр: Указатель;
ScanLineInc: Целое число;
maxRects: Кардинал;
начинать
Результат:= 0;
{ Держите под рукой самые низкие и самые высокие значения для «прозрачных» пикселей }
лр := GetRValue(TransparentColor);
lg := GetGValue(TransparentColor);
lb := GetBValue(TransparentColor);
час := Мин($ff, lr + RedTol);
hg := Min($ff, lg + GreenTol);
hb := Min($ff, lb + BlueTol);
bmp.PixelFormat:= pf32bit;
maxRects := AllocUnit;
GetMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects));
пытаться
с помощью RgnData^.rdh сделайте
начинать
dwSize := SizeOf(RGNDATAHEADER);
iType:= RDH_RECTANGLES;
nCount := 0;
nRgnSize: = 0;
SetRect(rcBound, MAXLONG, MAXLONG, 0, 0);
конец;
ScanLinePtr := bmp.ScanLine[0];
ScanLineInc := Целое число(bmp.ScanLine[1]) - Целое число(ScanLinePtr);
для y:= 0 до bmp.Height - 1 do
начинать
х:= 0;
в то время как x < bmp.Width do
начинать
х0 := х;
в то время как x < bmp.Width do
начинать
б := @PByteArray(ScanLinePtr)[x*SizeOf(TRGBQuad)];
// BGR-RGB: BMP Windows 32bpp состоят из четырехугольников BGRa (не RGBa)
если (b[2] >= lr) и (b[2] <= hr) и
(b[1] >= lg) и (b[1] <= hg) и
(b[0] >= lb) и (b[0] <= hb), то
Разрыв // пиксель прозрачный;
Инк(х);
конец;
{проверяем, есть ли на изображении непрозрачная область }
если х > х0, то
начинать
{ увеличиваем RgnData на прямоугольники AllocUnit, если мы превышаем maxRects }
если RgnData^.rdh.nCount >= maxRects, то
начинать
Inc(maxRects,AllocUnit);
ReallocMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
конец;
{ Добавьте прямоугольник (x0, y)-(x, y+1) в качестве новой видимой области в регионе }
pr := @RgnData^.Buffer // Буфер — это массив прямоугольников
с помощью RgnData^.rdh сделайте
начинать
SetRect(pr[nCount], x0, y, x, y+1);
{ корректируем ограниченный прямоугольник региона, если мы находимся «за пределами границ» }
если x0 < rcBound.Left, то rcBound.Left := x0;
если y < rcBound.Top, то rcBound.Top := y;
если x > rcBound.Right, то rcBound.Right := x;
если y+1 > rcBound.Bottom, то rcBound.Bottom := y+1;
Inc(nCount);
конец;
конец // если х > х0;
если RgnData^.rdh.nCount = 2000, то
начинать
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * maxRects), RgnData^);
если Результат > 0, то
начало // Расширяем текущий регион
ОбъединитьRgn(Результат, Результат, ч, RGN_OR);
УдалитьОбъект(ч);
конец
else // Первый регион, назначьте его результату
Результат := ч;
RgnData^.rdh.nCount := 0;
SetRect(RgnData^.rdh.rcBound, MAXLONG, MAXLONG, 0, 0);
конец;
Инк(х);
end // сканируем каждый байт изображения
Inc(Целое число(ScanLinePtr), ScanLineInc);
конец;
{ нужно вызвать ExCreateRegion еще раз, потому что мы могли бы уйти }
{ RgnData с менее чем 2000 прямоугольниками, поэтому он еще не был создан/объединен }
h := ExtCreateRegion(nil, SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects), RgnData^);
если Результат > 0, то
начинать
ОбъединитьRgn(Результат, Результат, ч, RGN_OR);
УдалитьОбъект(ч);
конец
еще
Результат := ч;
окончательно
FreeMem(RgnData,SizeOf(RGNDATAHEADER) + (SizeOf(TRect) * MaxRects));
конец;
-------------------------------------------------- --------------------------------