Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.11.07;
Скачать: CL | DM;

Вниз

Почему иногда неверно работает?   Найти похожие ветки 

 
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;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.047 c
4-1096373253
-SeM-
2004-09-28 16:07
2004.11.07
Разная работа приложения в 9х/ХР


3-1097233419
NewDelpher
2004-10-08 15:03
2004.11.07
select в функции не получается


3-1097055881
msguns
2004-10-06 13:44
2004.11.07
ADO+MSAccess+Update


14-1098089058
Undert
2004-10-18 12:44
2004.11.07
Проблема с MYSQL


8-1091702937
race1
2004-08-05 14:48
2004.11.07
tmediaplayer.position в нужном формате