unit
Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
TForm3 =
class
(TForm)
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
Button2: TButton;
I1: TImage;
PB: TProgressBar;
procedure
Button1Click(Sender: TObject);
procedure
Button2Click(Sender: TObject);
private
public
end
;
var
Form3: TForm3;
implementation
{$R *.dfm}
Procedure
RGBr(RGB:
string
;
VAR
Rs,Gs,Bs:
String
);
Begin
Rs:=Copy(RGB,
1
,
2
);
delete(RGB,
1
,
2
);
Gs:=Copy(RGB,
1
,
2
);
delete(RGB,
1
,
2
);
Bs:=RGB;
End
;
Procedure
RGBm(rm,gm,bm:
integer
;
VAR
Rs,Gs,Bs:
string
);
VAR
bty:
byte
;
Begin
bty:=strtoint(
'$'
+rs)+rm;
rs:=inttohex(bty,
2
);
bty:=strtoint(
'$'
+gs)+gm;
gs:=inttohex(bty,
2
);
bty:=strtoint(
'$'
+bs)+bm;
bs:=inttohex(bty,
2
);
End
;
Procedure
WriteToBmp(FileName,BitmapName,SavePath:
string
);
VAR
i,j,len,olen:
integer
;
bm:TBitmap;
Rs,Gs,Bs,RGB,bt:
string
;
mR,mG,mB:
byte
;
b:
byte
;
F:
File
;
begin
bm:=TBitmap
.
Create;
bm
.
LoadFromFile(BitmapName);
assignfile(F,Filename);
reset(F,
1
);
len:=Filesize(F);
ShowMessage(
'объем информации равен '
+inttostr(bm
.
Width*bm
.
Height)+
'будет записано '
+inttostr(len));
Form3
.
PB
.
Min:=
0
;
form3
.
PB
.
Max:=bm
.
Width;
for
I :=
0
to
bm
.
Width -
1
do
begin
for
j :=
0
to
bm
.
Height -
1
do
Begin
RGB:=IntToHex(ColorToRGB(bm
.
Canvas
.
Pixels[i,j]),
6
);
RGBr(RGB,rs,gs,bs);
if
not
(EoF(F))
then
Begin
BlockRead(F,b,
1
);
bt:=inttostr(b);
if
length(bt)=
1
then
bt:=
'00'
+bt
else
if
length(bt)=
2
then
bt:=
'0'
+bt;
mR:=StrToint(copy(bt,
1
,
1
));
mG:=StrToint(copy(bt,
2
,
1
));
mB:=StrToint(copy(bt,
3
,
1
));
End
else
begin
mr:=
0
;
mg:=
0
;
mb:=
0
;
end
;
RGBm(mR,mG,mB,rs,gs,bs);
RGB:=rs+gs+Bs;
bm
.
Canvas
.
Pixels[i,j]:=strtoint(
'$'
+RGB);
End
;
Form3
.
PB
.
Position:=i;
end
;
bm
.
SaveToFile(SavePath);
Closefile(F);
End
;
Procedure
RGBc(R1,G1,B1,R2,G2,B2:
string
;
VAR
b:
byte
);
VAR
rm,gm,bm:
byte
;
s:
string
;
Begin
Rm:=strtoint(
'$'
+R2)-strtoint(
'$'
+R1);
Gm:=strtoint(
'$'
+G2)-strtoint(
'$'
+G1);
Bm:=strtoint(
'$'
+B2)-strtoint(
'$'
+B1);
s:=inttostr(
abs
(Rm))+inttostr(
abs
(Gm))+inttostr(
abs
(Bm));
b:=StrToInt(s);
End
;
Procedure
WriteToFile(FileName,BitmapName,SavePath:
string
);
VAR
i,j,len,olen:
integer
;
bm:TBitmap;
Rs,Gs,Bs,RGB,bt:
string
;
mR,mG,mB:
integer
;
bm1:TBitmap;
Rs1,Gs1,Bs1,RGB1,bt1:
string
;
b:
byte
;
F:
File
;
begin
bm:=TBitmap
.
Create;
bm
.
LoadFromFile(BitmapName);
bm1:=Tbitmap
.
Create;
bm1
.
LoadFromFile(SavePath);
assignfile(F,Filename);
rewrite(F,
1
);
len:=Filesize(F);
Form3
.
PB
.
Min:=
0
;
form3
.
PB
.
Max:=bm
.
Width;
for
I :=
0
to
bm
.
Width -
1
do
begin
for
j :=
0
to
bm
.
Height -
1
do
Begin
RGB:=IntToHex(ColorToRGB(bm
.
Canvas
.
Pixels[i,j]),
6
);
RGB1:=IntToHex(ColorToRGB(bm1
.
Canvas
.
Pixels[i,j]),
6
);
RGBr(RGB,rs,gs,bs);
RGBr(RGB1,rs1,gs1,bs1);
RGBc(rs,gs,bs,rs1,gs1,bs1,b);
BlockWrite(F,b,
1
);
End
;
Form3
.
PB
.
Position:=i;
end
;
Closefile(F);
End
;
procedure
TForm3
.
Button1Click(Sender: TObject);
begin
WriteToBmp(Edit3
.
text,edit1
.
Text,Edit2
.
Text);
end
;
procedure
TForm3
.
Button2Click(Sender: TObject);
begin
WriteToFile(Edit3
.
text,edit1
.
Text,Edit2
.
Text);
end
;
end
.