📄 bmpreplace.pas
字号:
Cancel:=False;
Percent:=0;
Action:=ml.GetCodeString('BMPReplace',13);
if Assigned(FActionChange) then FActionChange(self,Action);
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
Skip:=0;
Col:=0;
ESC:=False;
DStream:=TMemoryStream.Create;
// get size
ImgData.Seek(0,soFromBeginning);
CRead:=ImgData.Read(CBuffer,1024);
for i:=0 to 2 do S24[i]:=0;
Size:=0;
i:=0;
CPos:=0;
j:=7;
while i<3 do begin
if Skip>0 then begin
Dec(Skip);
if Col>0 then begin
// decode
S24[i]:=S24[i]+((CBuffer[CPos] and 1) shl j);
if j>0 then Dec(j) else begin
j:=7;
Inc(i);
end;
// ------
Dec(Col);
end;
end
else begin
Col:=0;
if not(ESC) then begin
if CBuffer[CPos]=0 then ESC:=True
else begin
Skip:=1;
Col:=1;
end;
end
else begin
ESC:=False;
if CBuffer[CPos]=2 then begin
Skip:=2;
Col:=0;
end;
if CBuffer[CPos]>2 then begin
Col:=CBuffer[CPos];
if (CBuffer[i] mod 2)>0 then Skip:=CBuffer[CPos]+1
else Skip:=CBuffer[CPos];
end;
end;
end;
if CPos<CRead-1 then Inc(CPos)
else begin
CRead:=ImgData.Read(CBuffer,1024);
CPos:=0;
end;
end;
Size:=S24[0]+$100*S24[1]+$10000*S24[2];
DPos:=0;
DByte:=0;
i:=0;
j:=7;
while (i<Size) and not(Cancel) do begin
if Skip>0 then begin
Dec(Skip);
if Col>0 then begin
// decode
DByte:=DByte+((CBuffer[CPos] and 1) shl j);
if j>0 then Dec(j) else begin
j:=7;
DBuffer[DPos]:=DByte;
DByte:=0;
if DPos<1023 then Inc(DPos)
else begin
DPos:=0;
DStream.Write(DBuffer,1024);
end;
Inc(i);
end;
// ------
Dec(Col);
end;
end
else begin
Col:=0;
if not(ESC) then begin
if CBuffer[CPos]=0 then ESC:=True
else begin
Skip:=1;
Col:=1;
end;
end
else begin
ESC:=False;
if CBuffer[CPos]=2 then begin
Skip:=2;
Col:=0;
end;
if CBuffer[CPos]>2 then begin
Col:=CBuffer[CPos];
if (CBuffer[i] mod 2)>0 then Skip:=CBuffer[CPos]+1
else Skip:=CBuffer[CPos];
end;
end;
end;
if CPos<CRead-1 then Inc(CPos)
else begin
CRead:=ImgData.Read(CBuffer,1024);
CPos:=0;
end;
Percent:=Trunc(i/Size);
if CRead=0 then break;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
if Assigned(FWantCancel) then FWantCancel(self,Cancel);
Application.ProcessMessages;
end;
DStream.Write(DBuffer,DPos);
ResultFile.LoadFromStream(DStream);
DStream.Free;
Percent:=100;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
Decode8RLE:=True;
end;
function TBMPReplace.Encode4RLE(ToHide: TDataFile): Boolean;
var
CBuffer: Array[0..1023] of Byte;
DBuffer: Array[0..1023] of Byte;
CRead: Integer;
CPos: Integer;
DStream: TStream;
DRead: Integer;
DPos: Integer;
i, j: Integer;
Modified: TStream;
ht: TPaletteHashTable;
Skip: Integer;
Col: Integer;
ESC: Boolean;
p: Integer;
Cancel: Boolean;
begin
Cancel:=False;
ht:=CreateNewPalette;
Percent:=0;
Action:=ml.GetCodeString('BMPReplace',14);
if Assigned(FActionChange) then FActionChange(self,Action);
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
biHeader.ClrUsed:=16;
bfHeader.Offset:=54+64;
ImgData.Seek(0,soFromBeginning);
Modified:=TMemoryStream.Create;
CRead:=1024;
DStream:=TMemoryStream.Create;
ToHide.SaveToStream(DStream);
DStream.Seek(0,soFromBeginning);
DRead:=DStream.Read(DBuffer,1024);
DPos:=0;
j:=3;
ESC:=False;
Skip:=0;
Col:=0;
p:=Trunc(ImgData.Size/1024);
while (CRead=1024) and not(Cancel) do begin
CRead:=ImgData.Read(CBuffer,1024);
for i:=0 to CRead-1 do begin
if Skip>0 then begin
Dec(Skip);
if Col>0 then begin
// encode
CBuffer[i]:=((ht[(CBuffer[i] and $F0) shr 4]) shl 4)+(ht[CBuffer[i] and $0F]);
if DRead>0 then begin
if (DBuffer[DPos] and (1 shl (2*j+1)))<>0 then Inc(CBuffer[i],16);
if (DBuffer[DPos] and (1 shl (2*j)))<>0 then Inc(CBuffer[i],1);
end;
if j>0 then Dec(j)
else begin
j:=3;
if DPos<DRead-1 then Inc(DPos)
else begin
if DRead=1024 then DRead:=DStream.Read(DBuffer,1024)
else DRead:=0;
DPos:=0;
end;
end;
// -------
Dec(Col);
end;
end
else begin
Col:=0;
if not(ESC) then begin
if CBuffer[i]=0 then ESC:=True
else begin
Skip:=1;
Col:=1;
end;
end
else begin
ESC:=False;
if CBuffer[i]=2 then begin
Skip:=2;
Col:=0;
end;
if CBuffer[i]>2 then begin
Col:=Trunc(CBuffer[i]/2);
if (CBuffer[i] mod 4)>0 then Skip:=CBuffer[i]+4-(CBuffer[i] mod 4)
else Skip:=CBuffer[i];
Skip:=Trunc(Skip/2);
end;
end;
end;
end;
Modified.Write(CBuffer,CRead);
Percent:=Percent+p;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
if Assigned(FWantCancel) then FWantCancel(self,Cancel);
Application.ProcessMessages;
end;
ImgData.Free;
ImgData:=Modified;
Percent:=100;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
Encode4RLE:=True;
end;
function TBMPReplace.Decode4RLE(ResultFile: TDataFile): Boolean;
var
DBuffer: Array[0..1023] of Byte;
CBuffer: Array[0..1023] of Byte;
DStream: TMemoryStream;
CPos: Integer;
DPos: Integer;
CRead: Integer;
Size: Longint;
i,j: Integer;
DByte: Byte;
S24: Array[0..2] of Byte;
Skip: Integer;
Col: Integer;
ESC: Boolean;
Cancel: Boolean;
begin
Cancel:=False;
Percent:=0;
Action:=ml.GetCodeString('BMPReplace',15);
if Assigned(FActionChange) then FActionChange(self,Action);
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
Skip:=0;
Col:=0;
ESC:=False;
DStream:=TMemoryStream.Create;
// get size
ImgData.Seek(0,soFromBeginning);
CRead:=ImgData.Read(CBuffer,1024);
for i:=0 to 2 do S24[i]:=0;
Size:=0;
i:=0;
CPos:=0;
j:=3;
while i<3 do begin
if Skip>0 then begin
Dec(Skip);
if Col>0 then begin
// decode
S24[i]:=S24[i]+(((CBuffer[CPos] and 16) shr 4) shl (2*j+1));
S24[i]:=S24[i]+((CBuffer[CPos] and 1) shl (2*j));
if j>0 then Dec(j) else begin
j:=3;
Inc(i);
end;
// ------
Dec(Col);
end;
end
else begin
Col:=0;
if not(ESC) then begin
if CBuffer[CPos]=0 then ESC:=True
else begin
Skip:=1;
Col:=1;
end;
end
else begin
ESC:=False;
if CBuffer[CPos]=2 then begin
Skip:=2;
Col:=0;
end;
if CBuffer[CPos]>2 then begin
Col:=Trunc(CBuffer[CPos]/2);
if (CBuffer[CPos] mod 4)>0 then Skip:=CBuffer[CPos]+4-(CBuffer[CPos] mod 4)
else Skip:=CBuffer[CPos];
Skip:=Trunc(Skip/2);
end;
end;
end;
if CPos<CRead-1 then Inc(CPos)
else begin
CRead:=ImgData.Read(CBuffer,1024);
CPos:=0;
end;
end;
Size:=S24[0]+$100*S24[1]+$10000*S24[2];
DPos:=0;
DByte:=0;
i:=0;
j:=3;
while (i<Size) and not(Cancel) do begin
if Skip>0 then begin
Dec(Skip);
if Col>0 then begin
// decode
DByte:=DByte+(((CBuffer[CPos] and 16) shr 4) shl (2*j+1));
DByte:=DByte+((CBuffer[CPos] and 1) shl (2*j));
if j>0 then Dec(j) else begin
j:=3;
DBuffer[DPos]:=DByte;
DByte:=0;
if DPos<1023 then Inc(DPos)
else begin
DPos:=0;
DStream.Write(DBuffer,1024);
end;
Inc(i);
end;
// ------
Dec(Col);
end;
end
else begin
Col:=0;
if not(ESC) then begin
if CBuffer[CPos]=0 then ESC:=True
else begin
Skip:=1;
Col:=1;
end;
end
else begin
ESC:=False;
if CBuffer[CPos]=2 then begin
Skip:=2;
Col:=0;
end;
if CBuffer[CPos]>2 then begin
Col:=Trunc(CBuffer[CPos]/2);
if (CBuffer[CPos] mod 4)>0 then Skip:=CBuffer[CPos]+4-(CBuffer[CPos] mod 4)
else Skip:=CBuffer[CPos];
Skip:=Trunc(Skip/2);
end;
end;
end;
if CPos<CRead-1 then Inc(CPos)
else begin
CRead:=ImgData.Read(CBuffer,1024);
CPos:=0;
end;
Percent:=Trunc(i/Size);
if CRead=0 then break;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
if Assigned(FWantCancel) then FWantCancel(self,Cancel);
Application.ProcessMessages;
end;
DStream.Write(DBuffer,DPos);
ResultFile.LoadFromStream(DStream);
DStream.Free;
Percent:=100;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
Decode4RLE:=True;
end;
function TBMPReplace.CreateNewPalette: TPaletteHashTable;
var
// BytesRead: Integer;
// Buffer: Array[0..1023] of Byte;
Histo: THistogram;
ColIdx: Array[0..255] of Integer;
i,j: Integer;
Count: Integer;
newPal: TBMPPalette;
Hash: TPaletteHashTable;
v: Integer;
min: Integer;
n: Integer;
c: Byte;
Cancel: Boolean;
begin
Cancel:=False;
Percent:=0;
Action:=ml.GetCodeString('BMPReplace',16);
if Assigned(FActionChange) then FActionChange(self,Action);
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
n:=1 shl biHeader.BitCount;
for i:=0 to 255 do Histo[i]:=0;
for i:=0 to 255 do ColIdx[i]:=i;
for i:=0 to 255 do Hash[i]:=0;
if biHeader.Compression=0 then Histo:=GetHisto
else Histo:=GetHistoRLE;
Count:=0;
for i:=0 to n-1 do
if Histo[i]<>0 then Inc(Count);
if Count<=(n div 2) then begin
// sort histogram
for i:=0 to n-2 do begin
min:=i;
j:=i;
for j:=i+1 to n-1 do begin
if Histo[j]<Histo[min] then min:=j;
v:=Histo[min];
Histo[min]:=Histo[i];
Histo[i]:=v;
c:=ColIdx[min];
ColIdx[min]:=ColIdx[i];
ColIdx[i]:=c;
end;
end;
// build new palette with first half of colors
newpal:=TBMPPalette.Create;
newpal.SetBitPixel(biHeader.BitCount);
for i:=(n-1) downto (n div 2) do begin
newpal.Data[(n-i-1)*2]:=bmPalette.Data[ColIdx[i]];
newpal.Data[(n-i-1)*2+1]:=bmPalette.Data[ColIdx[i]];
Hash[ColIdx[i]]:=(n-i-1)*2;
end;
bmPalette.Free;
bmPalette:=newpal;
CreateNewPalette:=Hash;
Percent:=100;
if Assigned(FPercentChange) then FPercentChange(self,Percent);
Application.ProcessMessages;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -