Создание окна нестандартной формы

[bloodlines]

Собственно, как такое можно сделать в lazarus? В винде (must die) это можно сделать с помощью регионов (Region). А как это делать в linux? Есть ли кроссплатформенное решение?

[Павел Ишенин]

TWinControl.SetShape()

[Slavikk]

TWinControl.SetShape - пример применения можно? Так как у меня чего то с использованием TBitmap ничего не получается.

[Павел Ишенин]

lazarus\examples\shapedcontrols\

[Slavikk]

Спасибо. Давно видать я в примеры не заглядывал.

[Andreich]

А нет ли чего-нибудь подобного для для Linux?

[Mr.Smart]

Andreich
Это кроссплатформенное решение.

[coyot.rush]

Попробовал я создать нестандартную форму в windows . Получилось, но захотелось сделать форму "анимированной" ; использовал ImageList.
И получил ошибку спустя некоторое время работы программы, ошибка классический AV, но где я что не так сделал не пойму

Код: Выделить всё

unit main;



{$mode delphi}{$H+}



interface



uses

  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,

  ExtCtrls, windows ;











type



{ TAnimTh }



TAnimTh=class(tthread)

procedure Draw();

protected



procedure execute;override;



end;





type



  { TForm1 }



  TForm1 = class(TForm)

    ImMask: TImage;

    ImageList1: TImageList;

    procedure FormCreate(Sender: TObject);

  private

    { private declarations }

  public



  end; 









var

  Form1: TForm1; 

  Count:integer=0;

  animth:TAnimTh;

  f_x:integer=0;

implementation



{ TForm1 }









procedure BitmapWindow(AHWND : HWND; ABitmap : Graphics.TBitmap);

var

   back_color : COLORREF;

   w,h,x,x0,y : integer;

   wnd_dc,hdc_bmp : HDC;

   tmp_rgn,wnd_rgn : HRGN;

begin

  w := ABitmap.Width;

  h := ABitmap.Height;

  wnd_dc := GetDC(aHwnd);

  hdc_bmp := CreateCompatibleDC(wnd_dc);

  SelectObject(hdc_bmp,ABitmap.Handle);

  back_color := GetPixel(hdc_bmp,0,0);

  tmp_rgn := CreateRectRgn(0,0,0,0);

  wnd_rgn := CreateRectRgn(0,0,0,0);

  x := 0;

  for y := 0 to h-1 do

  begin

    while (x < w-1) do

    begin

      while ((GetPixel(hdc_bmp,x,y) = back_color) and (x < w)) do inc(x);

      if(x <> w) then

        begin

          x0 := x;

          while ((GetPixel(hdc_bmp, x, y) <> back_color) and (x < w)) do inc(x);

          tmp_rgn := CreateRectRgn(x0,y,x,y+1);

          CombineRgn(wnd_rgn,wnd_rgn,tmp_rgn,RGN_XOR);

        end;

    end;

    x := 0;

  end;

  DeleteObject(tmp_rgn);

  DeleteDC(hdc_bmp);

  SetWindowRgn(aHwnd, wnd_rgn, true);

  DeleteObject(wnd_rgn);

end;











procedure TForm1.FormCreate(Sender: TObject);

begin

 animth:=TAnimTh.Create(False);

end;













{ TAnimTh }



procedure TAnimTh.Draw();

begin

Inc(Count);

Inc(f_x);



if f_x>640 then f_x:=0;

if Count>=form1.ImageList1.Count then Count:=0;

form1.ImageList1.GetBitmap(Count,Form1.ImMask.Picture.Bitmap);

BitmapWindow(Form1.Handle,Form1.ImMask.Picture.Bitmap);



Form1.Left:=f_x;





end;







procedure TAnimTh.execute;

begin

while not Terminated do

begin

 Sleep(50);

 Synchronize(Draw);

end;

end;



initialization

  {$I main.lrs}



end.

PS:
Вроде здесь чего то не хватает
...Free

Код: Выделить всё

form1.ImageList1.GetBitmap(Count,Form1.ImMask.Picture.Bitmap);

BitmapWindow(Form1.Handle,Form1.ImMask.Picture.Bitmap)

starform.7z