Логин: Пароль:    Регистрация Всеми возможностями сайта можно пользоваться
только после авторизации.
   Забыли пароль?

Поиск
L



Статистика
u
Пользователи онлайн: нет
Гостей онлайн: 3
Всего онлайн: 3
Зарегистрировано юзеров: 6362
Комментариев на сайте: 645
Новый юзер: Pseulairrerve



Последние комментарии
c
Aqel прокомментировал "Урок 71 - Работа с сжатыми файлами":
GZip псевдоархив, на мой вопрос тоже не отвечают, как распаковать отдельные файлы/папки...
Pingitrus прокомментировал "Урок 71 - Работа с сжатыми файлами":
Есть еще кто нибудь живой на этом сайте, кто сможет помочь? Так то все работает, zip и rar распаковывает, но у меня есть файл dat который сжат GZip, почему то его не удается распаковать или так не получится так как этот файл не является архивом или является?)) пишет ошибку что неверная функция



Мы в соцсетях
c
Delphi
Конвертирование графических форматов

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

1. Конвертирование BMP в EMF

Следующая несложная процедура конвертирует bmp-файл SourceFileName в emf-файл и располагает его в той же директории, что и исходный файл.

function bmp2emf( const SourceFileName: TFileName): Boolean; 
var Metafile: TMetafile; MetaCanvas: TMetafileCanvas; Bitmap: TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  try 
    Bitmap := TBitmap.Create; 
    try 
      Bitmap.LoadFromFile(SourceFileName); 
      Metafile.Height := Bitmap.Height; 
      Metafile.Width := Bitmap.Width; 
      MetaCanvas := TMetafileCanvas.Create(Metafile, 0); 
      try 
        MetaCanvas.Draw(0, 0, Bitmap); 
      finally 
        MetaCanvas.Free; 
      end; 
    finally 
      Bitmap.Free; 
    end; 
    Metafile.SaveToFile(ChangeFileExt(SourceFileName, '.emf')); 
  finally 
    Metafile.Free;
  end; 
end;
Пример вызова:
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  bmp2emf('C:\TestBitmap.bmp');
end;
2. Конвертирование BMP в JPG

Данная процедура выполняет такое конвертирование:
procedure TfrmMain.ConvertBMP2JPEG; 
var 
  jpgImg: TJPEGImage; 
begin 
  chrtOutputSingle.CopyToClipboardBitmap; 
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0); 
  jpgImg := TJPEGImage.Create; 
  jpgImg.Assign(Image1.Picture.Bitmap); 
  jpgImg.SaveToFile('TChartExample.jpg'); 
end;
В Uses необходимо добавить модули Jpeg и Clipbrd. В данном примере chrtOutputSingle - это объект TChart (страница Additional). Перед вызовом функции в буфере обмена должен находиться объект типа TBitmap.

3. Конвертирование BMP в WMF

Данное конвертирование также не составляет труда:
procedure ConvertBMP2WMF (const BMPFileName, WMFFileName: TFileName); 
var 
  MetaFile : TMetafile; 
  Bitmap : TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  Bitmap := TBitmap.Create; 
  try 
    Bitmap.LoadFromFile(BMPFileName); 
    with MetaFile do 
    begin 
      Height := Bitmap.Height; 
      Width := Bitmap.Width; 
      Canvas.Draw( 0 , 0 , Bitmap); 
      SaveToFile(WMFFileName); 
    end; 
  finally 
    Bitmap.Free; 
    MetaFile.Free; 
  end;
end;
Пример использования:
ConvertBMP2WMF('c:\mypic.bmp','c:\mypic.wmf');
4. Обратное конвертирование: WMF в BMP

Обратное конвертирование мало чем отличается от предыдущего:
procedure ConvertWMF2BMP (const WMFFileName, BMPFileName: TFileName); 
var 
  MetaFile : TMetafile; 
  Bitmap : TBitmap; 
begin 
  Metafile := TMetaFile.Create; 
  Bitmap := TBitmap.Create; 
  try 
    MetaFile.LoadFromFile(WMFFileName); 
    with Bitmap do 
    begin 
      Height := Metafile.Height; 
      Width := Metafile.Width; 
      Canvas.Draw( 0 , 0 , MetaFile); 
      SaveToFile(BMPFileName); 
    end; 
  finally 
    Bitmap.Free; 
    MetaFile.Free; 
  end;
end;
Использование:
ConvertWMF2BMP('c:\mypic.wmf','c:\mypic.bmp');
5. Конвертирование BMP в DIB

Допустим, что файл хранится в формате BMP. Нужно его преобразовать в DIB и отобразить. Итак... Это не тривиально, но помочь нам смогут функции GetDIBSizes и GetDIB из модуля GRAPHICS.PAS. Приведу две процедуры: одну для создания DIB из TBitmap и вторую для его освобождения:
procedure BitmapToDIB(Bitmap: TBitmap; 
var
  BitmapInfo: PBitmapInfo; 
  InfoSize: integer; 
  Bits: pointer; 
  BitsSize: longint); 
begin 
  BitmapInfo := nil ; 
  InfoSize := 0; 
  Bits := nil; 
  BitsSize := 0; 
  if not Bitmap.Empty then 
    try 
      GetDIBSizes(Bitmap.Handle, InfoSize, BitsSize); 
      GetMem(BitmapInfo, InfoSize); 
      Bits := GlobalAllocPtr(GMEM_MOVEABLE, BitsSize); 
      if Bits = nil then 
        raise EOutOfMemory.Create( 'Не хватает памяти для пикселей изображения' );
      if not GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapInfo^, Bits^) then
        raise Exception.Create( 'Не могу создать DIB' );
    except
      if BitmapInfo <> nil then
        FreeMem(BitmapInfo, InfoSize);
      if Bits <> nil then
        GlobalFreePtr(Bits);
      BitmapInfo := nil;
      Bits := nil;
      raise ;
    end;
end;
 
{ используйте FreeDIB для освобождения информации об изображении и битовых указателей } 
 
procedure FreeDIB(BitmapInfo: PBitmapInfo; InfoSize: integer; Bits: pointer; BitsSize: longint); 
begin 
  if BitmapInfo <> nil then
    FreeMem(BitmapInfo, InfoSize);
  if Bits <> nil then
    GlobalFreePtr(Bits);
end;
Создаём форму с TImage Image1 и загружаем в него 256-цветное изображение, затем рядом размещаем TPaintBox. Добавляем следующие строчки к private-объявлениям нашей формы:
{ Private declarations } 
BitmapInfo : PBitmapInfo; 
InfoSize : integer; 
Bits : pointer; 
BitsSize : longint;
Создаем нижеприведенные обработчики событий, которые демонстрируют процесс отрисовки DIB:
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  BitmapToDIB(Image1.Picture.Bitmap, BitmapInfo, InfoSize, Bits, BitsSize); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeDIB(BitmapInfo, InfoSize, Bits, BitsSize);
end; 
 
procedure TForm1.PaintBox1Paint(Sender: TObject); 
var 
  OldPalette: HPalette;
begin 
  if Assigned(BitmapInfo) and Assigned(Bits) then 
    with BitmapInfo^.bmiHeader, PaintBox1.Canvas do 
    begin 
      OldPalette := SelectPalette(Handle,Image1.Picture.Bitmap.Palette,false); 
      try 
        RealizePalette(Handle); 
        StretchDIBits(Handle, 0 , 0 , PaintBox1.Width, PaintBox1.Height, 0 , 0 , biWidth, biHeight, Bits, BitmapInfo^,
DIB_RGB_COLORS, SRCCOPY);
      finally
        SelectPalette(Handle, OldPalette, true);
      end;
    end;
end;
Это поможет вам сделать первый шаг. Единственное, что вы можете захотеть, это создать собственный HPalette на основе DIB, вместо использования TBitmap и своей палитры. Функция с именем PaletteFromW3DIB из GRAPHICS.PAS как раз этим и занимается, но она не объявлена в качестве экспортируемой, поэтому для ее использования необходимо скопировать ее исходный код и вставить его в модуль.

6. Конвертирование BMP в ICO

Вам необходимо создать два битмапа, битмап маски (назовём его "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;
Способ преобразования изображения размером 32x32 в иконку:
procedure TForm1.Button1Click(Sender: TObject); 
var 
  winDC, srcdc, destdc: HDC; 
  oldBitmap: HBitmap; 
  iinfo: TICONINFO; 
begin 
  GetIconInfo(Image1.Picture.Icon.Handle, iinfo); 
 
  WinDC := getDC(handle); 
  srcDC := CreateCompatibleDC(WinDC); 
  destDC := CreateCompatibleDC(WinDC); 
  oldBitmap := SelectObject(destDC, iinfo.hbmColor); 
  oldBitmap := SelectObject(srcDC, iinfo.hbmMask); 
 
  BitBlt(destdc, 0 , 0 , Image1.Picture.Icon.Width, Image1.Picture.Icon.Height, srcdc, 0 , 0 , SRCPAINT); 
  Image2.Picture.Bitmap.Handle := SelectObject(destDC, oldBitmap); 
  DeleteDC(destDC); 
  DeleteDC(srcDC); 
  DeleteDC(WinDC); 
 
  Image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.bmp' ); 
end;
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Image1.Picture.Icon.LoadFromFile('c:\myicon.ico');
end;
7. Конвертирование BMP в RTF

Да, и такое тоже возможно. Вот так например:
function BitmapToRTF(pict: TBitmap): string ; 
var 
  bi, bb, rtf: string ; 
  bis, bbs: Cardinal; 
  achar: ShortString; 
  hexpict: string ; 
  I: Integer; 
begin 
  GetDIBSizes(pict.Handle, bis, bbs); 
  SetLength(bi, bis); 
  SetLength(bb, bbs); 
  GetDIB(pict.Handle, pict.Palette, PChar(bi)^, PChar(bb)^); 
  rtf := '{\rtf1 {\pict\dibitmap0 ' ; 
  SetLength(hexpict, (Length(bb) + Length(bi)) * 2 ); 
  I := 2 ; 
  for bis := 1 to Length(bi) do 
  begin 
    achar := IntToHex(Integer(bi[bis]), 2 ); 
    hexpict[I - 1] := achar[ 1 ]; 
    hexpict[I] := achar[ 2 ]; 
    Inc(I, 2 ); 
  end ; 
  for bbs := 1 to Length(bb) do 
  begin 
    achar := IntToHex(Integer(bb[bbs]), 2 ); 
    hexpict[I - 1] := achar[ 1 ]; 
    hexpict[I] := achar[ 2 ]; 
    Inc(I, 2); 
  end ; 
  rtf := rtf + hexpict + ' }}'; 
  Result := rtf; 
end;
8. Конвертирование CUR в BMP

Преобразование курсора в TBitmap:
procedure TForm1.Button1Click(Sender: TObject); 
var 
  hCursor: LongInt; 
  Bitmap: TBitmap; 
begin 
  Bitmap := TBitmap.Create; 
  Bitmap.Width := 32 ; 
  Bitmap.Height := 32 ; 
  hCursor := LoadCursorFromFile( 'test.cur' ); 
  DrawIcon(Bitmap.Canvas.Handle, 0 , 0 , hCursor); 
  Bitmap.SaveToFile( 'test.bmp' ); 
  Bitmap.Free; 
end;
9. Конвертирование ICO в BMP
var
  Icon : TIcon; 
  Bitmap : TBitmap; 
begin 
  Icon := TIcon.Create; 
  Bitmap := TBitmap.Create; 
  Icon.LoadFromFile( 'c:\picture.ico' ); 
  Bitmap.Width := Icon.Width; 
  Bitmap.Height := Icon.Height; 
  Bitmap.Canvas.Draw( 0 , 0 , Icon); 
  Bitmap.SaveToFile( 'c:\picture.bmp' ); 
  Icon.Free; 
  Bitmap.Free; 
end;
Вариант 2:
var 
  MyIcon: TIcon; 
  MyBitMap: TBitmap; 
begin
  MyIcon := TIcon.Create; 
  MyBitMap := TBitmap.Create; 
 
  try
    { получаем имя файла и связанную с ним иконку} 
    strFileName := FileListBox1.Items[FileListBox1.ItemIndex]; 
    StrPCopy(cStrFileName, strFileName); 
    MyIcon.Handle := ExtractIcon(hInstance, cStrFileName, 0 ); 
 
    { рисуем иконку на bitmap в speedbutton } 
    SpeedButton1.Glyph := MyBitMap; 
    SpeedButton1.Glyph.Width := MyIcon.Width; 
    SpeedButton1.Glyph.Height := MyIcon.Height; 
    SpeedButton1.Glyph.Canvas.Draw( 0 , 0 , MyIcon); 
 
    SpeedButton1.Hint := strFileName; 
 
  finally
    MyIcon.Free;
    MyBitMap.Free;
  end; 
end;
Чтобы преобразовать Icon в Bitmap, используйте TImageList. Для обратного преобразования замените метод AddIcon на Add, и метод GetBitmap на GetIcon.
function Icon2Bitmap(Icon: TIcon): TBitmap; 
begin 
  with TImageList.Create ( nil ) do 
  begin 
    AddIcon (Icon); 
    Result := TBitmap.Create; 
    GetBitmap ( 0 , Result); 
    Free;
  end;
end;
10. Конвертирование JPG в BMP.
uses JPEG;
 
procedure JPEGtoBMP( const FileName: TFileName);
var
  jpeg: TJPEGImage;
  bmp: TBitmap;
begin 
  jpeg := TJPEGImage.Create; 
  try 
    jpeg.CompressionQuality := 100 ; {Default Value} 
    jpeg.LoadFromFile(FileName); 
    bmp := TBitmap.Create; 
    try 
      bmp.Assign(jpeg); 
      bmp.SaveTofile(ChangeFileExt(FileName, '.bmp' )); 
    finally
      bmp.Free;
    end;
  finally
    jpeg.Free;
  end;
end;

Вот и всё, Удачи!

Источник: www.thedelphi.ru
Автор: Савельев Александр
Опубликовано: 14 Сентября 2014
Просмотров:


Зарегистрируйтесь или авторизуйтесь, чтобы добавлять комментарии.