Окно необычной формы

[Skrip]

Здравствуйте. Хочу научится создавать окна неправильной формы..
вот код:

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
//    function CreateRgnFromBitmap(rgnBitmap: TBitmap): HRGN;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  Dragging: Boolean;
  OldLeft, OldTop:Integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
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[1,1]:

 // Çàïóñêàþ öèêë ïåðåáîðà ñòðîê êàðòèíêè
 // äëÿ îïðåäåëåíèÿ îáëàñòè îêíà áåç ôîíà
 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.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if button=mbLeft then
  begin
    Dragging := True;
    OldLeft := X;
    OldTop := Y;
  end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Dragging then
  begin
    Left := Left+X-OldLeft;
    Top := Top+Y-OldTop;
  end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Dragging:=False;
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;

end.

Но почему-то у меня вообще окна не видно.. Я думаю ошибка где то в функции CreateRgnFromBitmap. М.б. кто-нибудь подскажет..

[TwiX]

Как создать форму определенной формы

Можно создать форму по картинке. Т.е. находишь картинку в форме ножниц и создаёшь по ней форму.
Код

procedure Tmain.WMNCHitTest (var M:TWMNCHitTest);
begin
inherited;
if M.Result = htClient then
M.Result := htCaption;
end;

procedure Tmain.FormCreate(Sender: TObject);
var
regn, tmpRegn: integer; // регион окна и временный регион
x, y: integer; // координаты пикселя
nullClr: TColor; // <прозрачный цвет>

begin
nullClr := image1.picture.Bitmap.Canvas.Pixels[0, 0];
// Image1 это картинка по которой создается форма окна
regn := CreateRectRgn(0, 0, image1.picture.Graphic.Width,
image1.picture.Graphic.Height);
for x := 1 to image1.picture.Graphic.Width do
for y := 1 to image1.picture.Graphic.Height do
if image1.picture.Bitmap.Canvas.Pixels[x - 1, y - 1] = nullClr then
begin
tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
DeleteObject(tmpRegn);
end;
SetWindowRgn(main.handle, regn, true);

end;

(c) pblog.ru

[Skrip]

хм.. все равно.. окна вообще нет..

[Пепел Феникса]

а вы пробывали более простой метод использовать?
чем сразу из BitMap'а делать?

[DeKot]

Вот прекрасная методика, не помню уже, кто из форумчан поделился (не я точно).

[mihali4]

Тоже чья-то старенькая:
Круглая форма.rar

[JTG]

Сорс из книжки Флёнова, тоже когда-то использовал, там вроде какая-то ошибка была В аттаче рабочий проект, когда-то клепал им rgn-файлы для использования в мелких прогах на ассемблере (занимают меньше места, чем битмапы).

Вообще в делфи это делается намного проще - кинуть на фон TImage и установить TransparentColorValue/TransparentColor:=true

[Skrip]

Спасибо большое!!