Почему иногда неверно работает?
Barbaris © (2004-10-25 16:57:00)
Рисую регионы формы по битмапу. Очень редко, но случается так,
что "прозрачные" регионы не вырезаются из формы программы.
Почему так?
function BitmapToRegion(bmp: TBitmap) : dword; stdcall;
var
ix,iy : integer;
tc : TColor;
b1 : boolean;
c1 : cardinal;
i1 : integer;
begin
Result := 0;
i1 := 0;
tc := bmp.transparentColor and $FFFFFF;
with bmp.canvas do
for iy := 0 to bmp.height - 1 do
begin
b1 := False;
for ix:=0 to bmp.Width - 1 do
if (pixels[ix, iy] and $FFFFFF
<> tc) <> b1 then begin
if b1 then begin
c1:=CreateRectRgn(i1,iy,ix,iy+1);
if result<>0
then
begin
CombineRgn(Result, Result, c1, RGN_OR);
DeleteObject(c1);
end
else
Result := c1;
end else i1 := ix;
b1:=not b1;
end;
if b1 then begin
c1:=CreateRectRgn(i1, iy,
bmp.width-1, iy+1);
if (Result <> 0) then
begin
CombineRgn(Result,
Result, c1, RGN_OR);
DeleteObject(c1);
end
else
Result := c1;
end;
end;
Application.ProcessMessages();
end;
procedure TMainForm.FormShow(Sender: TObject);
var
sapppath : string;
Region : HRGN;
P: TBitmap;
f : Textfile;
begin
sapppath := ExtractFilePath(Application.ExeName);
if FileExists(sapppath+'Resources\Main.rgn') then exit;
P := TBitmap.Create;
try
P.LoadFromFile(sapppath+'Resources\Images\Skins\Main_2.bmp');
DiscKeeper.Width := p.Width;
DiscKeeper.Height := p.Height;
Region := BitmapToRegion(p);
SetWindowRgn(DiscKeeper.Handle, Region,
True);
DeleteObject(Region);
finally
P.Free;
Assignfile(f,sapppath+'Resources\Main.rgn');
Rewrite(f);
Writeln(f,'qwerty');
closefile(f);
end;
end;
Rouse_ (2004-10-25 23:10:00) [1]
Было бы проще если бы та дал линк на регион с которым не
правильно работает данный алгоритм...
Наверх 
ЧАТ |
Орешник |
|
