位图异或操作
今天写给别人的一段代码。
View Code
procedure TfrmMain.btnXorClick(Sender: TObject);
var
dc: HDC;
x,y: Integer;
bmp1,bmp2,bmp3: TBitmap;
pt: TPoint;
const
WW=100; //Width
HH=100; //Height
XX=100; //X Coordinate
YY=100; //Y Coordinate
_SLEEP = 100; //Sleep times
procedure MySleep(ms:Cardinal);
var
tickCount: Cardinal;
begin
tickCount := GetTickCount;
while (GetTickCount-tickCount < ms) do
Application.ProcessMessages;
end;
procedure BitBltEx(aBMP: TBitmap; X, Y, PW, PH: integer);
begin
aBMP.PixelFormat := pf24bit;
aBMP.Width := PW;
aBMP.Height := PH;
BitBlt(aBMP.Canvas.Handle, 0, 0, PW, PH, dc, X, Y, SRCCOPY);
end;
procedure BmpXor(aBMP1,aBMP2,aBMP3: TBitmap);
var
i,j: Integer;
p1,p2,p3: pByteArray;
begin
for i := 0 to aBMP1.Height - 1 do
begin
p1 := aBMP1.ScanLine[i];
p2 := aBMP2.ScanLine[i];
p3 := aBMP3.ScanLine[i];
for j := 0 to aBMP1.Width - 1 do
begin
p3[3 * j + 2] := p1[3 * j + 2] xor p2[3 * j + 2];
p3[3 * j + 1] := p1[3 * j + 1] xor p2[3 * j + 1];
p3[3 * j + 0] := p1[3 * j + 0] xor p2[3 * j + 0];
end;
end;
end;
function GetCoordinate(aBMP: TBitmap): TPoint;
var
i,j,w,h,found,iTop,iLeft,iRight,iBottom: Integer;
p: pByteArray;
arrTemp: array of Byte;
begin
try
Result := Point(0,0);
found := 0;
iTop := 0; iLeft := 0; iRight:= 0; iBottom := 0;
SetLength(arrTemp,aBMP.Width * 3);
ZeroMemory(arrTemp,aBMP.Width * 3);
//Top
for i := 0 to aBMP.Height - 1 do
begin
p := aBMP.ScanLine[i];
if CompareMem(p,arrTemp,aBMP.Width * 3) then
Continue
else
begin
iTop := i;
break;
end;
end;
//Bottom
for i := aBMP.Height - 1 downto 0 do
begin
p := aBMP.ScanLine[i];
if CompareMem(p,arrTemp,aBMP.Width * 3) then
Continue
else
begin
iBottom := i;
break;
end;
end;
//Left
for j := 0 to aBMP.Width - 1 do
begin
for i := 0 to aBMP.Height - 1 do
begin
p := aBMP.ScanLine[i];
if (p[3 * j + 2]>0) or (p[3 * j + 1]>0) or (p[3 * j + 0]>0) then
begin
found := 1;
iLeft := j;
Break;
end;
end;
if found>0 then Break;
end;
found := 0;
//Right
for j := aBMP.Width - 1 downto 0 do
begin
for i := aBMP.Height - 1 downto 0 do
begin
p := aBMP.ScanLine[i];
if (p[3 * j + 2]>0) or (p[3 * j + 1]>0) or (p[3 * j + 0]>0) then
begin
found := 1;
iRight := j;
Break;
end;
end;
if found>0 then Break;
end;
w := iRight - iLeft;
h := iBottom - iTop;
Result.X := iLeft + w div 2;
Result.Y := iTop + h div 2;
except on e: Exception do
MessageBox(0,PChar(e.Message),'Error',0);
end;
end;
begin
//dc := CreateDC('DISPLAY', nil, nil, nil);
dc := GetDC(WebBrowser1.Handle);
bmp1 := TBitmap.Create;
bmp2 := TBitmap.Create;
bmp3 := TBitmap.Create;
x := xx;
y := yy;
try
BitBltEx(bmp1,x,y,WW,HH);
MySleep(_SLEEP);
BitBltEx(bmp2,x,y,WW,HH);
BitBltEx(bmp3,x,y,WW,HH);
BmpXor(bmp1,bmp2,bmp3);
Image1.Picture.Bitmap.Assign(bmp1);
Image2.Picture.Bitmap.Assign(bmp2);
Image3.Picture.Bitmap.Assign(bmp3);
pt := GetCoordinate(bmp3);
//ShowMessageFmt('X:%d,Y:%d',[pt.X,pt.Y]);
edtXY.Text := Format('X:%d,Y:%d',[pt.X,pt.Y]);
finally
bmp1.Free;
bmp2.Free;
bmp3.Free;
//DeleteDC(dc);
ReleaseDC(WebBrowser1.Handle,dc);
end;
end;