[ApplicatiOn]

Нужно сделать форму не ровной, не квадратной и не круглой, а чтобы она соответствовала нужной картинке.. Помогите пожалуйста!

[moo2k]

http://www.delphi-central.com/BitmapShapedForm.aspx

[ApplicatiOn]

тот код не компилируется..

23 ошибок...

Есть другие примеры?

[moo2k]

У меня скомпилилось отлично. Компилил в Delphi 7.

[cotseec]

Есть хороший компонент - PlazmaForm (у меня работал в 5 и 6 версиях Delphi, в 7 не скомпилилась при установке), задается картинка (любая), где различаются фон и сама картинка (по типу построения иконки *.ico, только фон сам указываешь в процессе написания проги) и при выполнении получается окошко любой формы. На просторах интернета новых версий (да и старых) давно не находил, кидаю в аттач, может поможет.

ЗЫ: спасибы можно кидать автору компоненты, его мыло и описание компоненты на буржуйском в ридми

[Andryha]

Сообщение от 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;

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