Форум: "Основная";
Текущий архив: 2004.11.07;
Скачать: [xml.tar.bz2];
ВнизПочему иногда неверно работает? Найти похожие ветки
← →
Barbaris (2004-10-25 16:57) [0]Рисую регионы формы по битмапу. Очень редко, но случается так, что "прозрачные" регионы не вырезаются из формы программы.
Почему так?
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) [1]Было бы проще если бы та дал линк на регион с которым не правильно работает данный алгоритм...
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.11.07;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.036 c