procedure TForm1.Button1Click(Sender: TObject); var fs: integer; fd: integer; i: integer; sname: string; dname: string; bufferS: Array[0..1] of SHORT; bufferD: Array[0..32565] of SHORT; cnt: integer; color: SHORT; ii: integer; width: integer; addon: integer; height: integer; begin OpenD.Filter:='Compressed Image (*.*)|*.*'; //Готвоим if OpenD.Execute then //и выполняем диалог выбора файла begin sname:=OpenD.FileName; if Trim(OpenD.FileName)<>'' then //Если файл выбран begin //открываем его для чтения fs:=FileOpen(OpenD.FileName,fmOpenRead); if fs=-1 then //Если не открылся begin //выходим из процедуры Application.MessageBox(PChar('Невозможно открыть исходный файл '+PChar(OpenD.FileName)),'Ошибка'); Exit; end; SaveD.Filter:='BMP Image File (*.bmp)|*.bmp'; //Готовим и if SaveD.Execute then //запускаем диалог сохранения файла begin if Trim(SaveD.FileName)<>'' then begin //Если имя для сохранения файла задано, if FileExists(SaveD.FileName+'.bmp') then //проверяем наличие такого файла на диске begin //Если файл существует, выводим диалог if Application.MessageBox(PChar('Файл '+PChar(SaveD.FileName)+'.bmp'+' существует. Переписать?'), 'Внимание!',MB_OKCANCEL)=IDCANCEL then begin FileClose(fs); //и в соответствии с выбором пользователя Exit; //либо прекращаем дальнейшую обработку end else //либо продолжаем ее DeleteFile(SaveD.FileName+'.bmp'); //удалив существующий файл end; fd:=FileCreate(SaveD.FileName+'.tmp'); //Создаем временный файл TMP, куда будем распаковывать данные if fd=-1 then //Если неудачно, begin Application.MessageBox(PChar('Невозможно создать файл '+PChar(SaveD.FileName)+'.bmp'),'Ошибка'); FileClose(fd); //закрываем запакованный файл Exit; //и прекращаем обработку end; end; FillChar(bufferD, 56, 0); //Фомируем буфер для записи заголовока файла TMP bufferD[0]:=$4D42; //Записываем в буфер сигнатуру 'BM' bufferD[5]:=$38; //затем - смещение начала растрового массива, которое должно быть кратно 4 bufferD[7]:=$28; //размер структуры BITMAPINFOHEADER FileSeek(fs,1,0); //Читаем из упакованного файла и FileRead(fs,bufferD[14],1); //записываем в буфер количество битов на пиксел FileSeek(fs,2,0); //Читаем и FileRead(fs,bufferD[9],2); //записываем в буфер ширину картинки (длину строки) width:=bufferD[9]*2; //Сохраняем для дальнейшей обработки длину строки растра в байтах addon:=width mod 4; //Определяем ее кратность 4-м if addon<>0 then //Если длина строки не кратна 4-м, определяем сколько addon:=4-addon; //нулевых байтов нужно добавить в конец строки для выравнивания FileSeek(fs,4,0); //Читаем из заголовка упакованного файла и FileRead(fs,bufferD[11],2); //записываем в буфер высоту картинки (количество строк растра) height:=bufferD[11]; //Сохраняем высоту картинки для дальнейшей обработки bufferD[13]:=1; //Записывем количество планов (для BMP всегда 1 ?) FileWrite(fd,bufferD,56); //Записываем сформированный заголовок из буфера в файл TMP FileSeek(fs,12,0); //Читаем длину запакованного тела FileRead(fs,bufferS,4); //сжатого файла и определяем i:=Integer(Addr(bufferS)^); //его длину в DWORD, (т.к читать будем по 4 байта) одновременно i:=i div 4; //позиционируем на начало данных. FileSeek(fd,0,2); //Позиционируем BMP на начало тела. if i>0 then //Если длина тела запакованного файла в DWORD > 0 begin //приступаем к распаковке файла в цикле, пока не будет прочитано i значений. repeat FileRead(fs,bufferS,4); //Читаем в буфер очередную пару счетчик-цвет (4 байта) из упакованного файла cnt:=Integer(bufferS[0])+1; //Определяем счетчик и увеличиваем его значение на единицу, как это принято в RLE color:=bufferS[1]; //Определяем цвет пикселя. for ii:=0 to cnt-1 do //Записываем в буфер значение цвета, повтороив его столько раз, begin //сколько задано в счетчике bufferD[ii]:=color; end; FileWrite(fd,bufferD,cnt*2); //Записываем данные из буфера в файл TMP. i:=i-1; //Уменьшаем значение пар "счетчик-цвет", которые осталось прочитать until i=0; end; FileClose(fs); //Закрываем исходный упакованный файл - он больше нам не нужен. //Вы полним перестановку строк растра, чтобы перевернуть их снизу вверх // и выполнить выравнивание, если оно необходимо, для чего: FileSeek(fd,0,0); //Ставим указатель в файле TMP на его начало fs:=FileCreate(SaveD.FileName+'.BMP'); //Создаем файл BMP, куда будем записывать окончательный результат i:=56+(width+addon)*height; //Вычисляем будущую длину файла BMP c учетом выравнивания строк по формуле //(длина заголовка + длина дополненной нулями строки * количество строк) ii:=i; //Сохраняем длину файла для дальнейших вычислений while i> SizeOf(bufferD) do //Увеличиваем длину файла BМP до вычисленного рамера begin //записав в него любую лабуду из нашего буфера (в цикле потому, FileWrite(fs,bufferD,SizeOf(bufferD)); //что FileWrite за раз может записать не более 65 535 байт, i:=i-SizeOf(bufferD); //а файл может оказаться и длинее end; if i>0 then //Если после цикла отсался хвост, FileWrite(fs,bufferD,i); //дописываем его FileSeek(fs,0,0); //Позиционируем указатель в файле BМP на его начало FileRead(fd,bufferD,56); //Читаем заголовок из файла TMP FileWrite(fs,bufferD,56); //и записываем его в файл BMP. FileSeek(fs,2,0); //Позиционируем указатель в файле BMP и FileWrite(fs,Addr(ii)^,4); //исправляем длину в заголовке, воспользовавшись ранее сохраненным значением ii FileSeek(fs,56,0); //Передвигаем указатель на начало данных растра в файле BMP FileSeek(fd,0,2); //Передвигаем указательв конец файла TMP и начинаем перемещение строк из конца в начало, for i:=1 to height do //выполняя чтение из TMP и запись в BMP в цикле: begin FileSeek(fd,-width,1); //Отодвигаем указатель в файле TMP назад на длину одной строки FileRead(fd,bufferD,width); //читаем строку в буфер FileSeek(fd,-width,1); //и отодвигаем указатель назад на количество только что прочитанных байтов. FileWrite(fs,bufferD,width+addon); //Записываем данные из буффера в файл BMP с учетом необходимого выравнивания end; FileClose(fs); //Закрываем FileClose(fd); //оба файла DeleteFile(SaveD.FileName+'.tmp'); //Удаляем временный файл TMP end; end; end; end;
