Показать сообщение отдельно
  #6  
Старый 04.05.2009, 15:23
Andryha Andryha вне форума
Прохожий
 
Регистрация: 04.05.2009
Адрес: Новосибирск
Сообщения: 5
Репутация: 10
По умолчанию

Цитата:
Сообщение от ApplicatiOn
Нужно сделать форму не ровной, не квадратной и не круглой, а чтобы она соответствовала нужной картинке.. Помогите пожалуйста!
Вот попробуй. Точно работает на delphi 7, 2006,2007:

Код:
function CreateRgnFromBitmap(rgnBitmap: TBitmap) : HRGN;
var
 TransColor: TColor;
 i, j: Integer;
 i_width, i_height: Integer;
 i_left, i_right: integer;
 rectRgn: HRGN;
begin
 Result :=0;
i_width := rgnBitmap.Width;
i_height := rgnBitmap.Height;

transcolor:= rgnBitmap.Canvas.Pixels[0, 0];

for i := 0 to i_height - 1 do
 begin
 i_left := -1;


 for j := 0 to i_width -1 do
  begin
   if i_left < 0 then
   begin
   if rgnBitmap.Canvas.Pixels[j, i] <> transColor then
    i_left := j;
   end
    else
    if rgnBitmap.Canvas.Pixels[j, i] = transcolor then
    begin
     i_right := j;
     rectRgn := CreateRectRgn(i_left, i, i_right, i + 1);
     if result = 0 then
     Result := rectRgn
    else
     begin
      CombineRgn(Result, Result, rectRgn, RGN_OR);
       DeleteObject(rectRgn);
      end;
     i_left := -1;
    end;
   end;
   if i_left >= 0 then
    begin
     rectRgn := CreateRectRgn(i_left, i, i_width, i + 1);
     if Result = 0 then
     Result := rectRgn
    else
     begin
     CombineRgn(Result, Result, rectRgn, RGN_OR);
     DeleteObject(rectRgn);
     end;
    end;
   end;
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
WindowRgn: HRGN;
begin
 BorderStyle :=bsNone;
 ClientWidth := Image1.Picture.Bitmap.Width;
 ClientHeight :=Image1.Picture.Bitmap.Height;
 windowRgn := CreateRgnFromBitmap(Image1.Picture.Bitmap);
 SetWindowRgn(Handle, WindowRgn, True);
end;

Заметь, что будет убираться цвет самого верхнего пикселя в картинке.
Ответить с цитированием