Не квадратная форма.Информация

[Dr_Grizzly]

Всем привет! Вот решил поделиться информацией. Как сделать форму не квадратной. Открываем графический редактор. Рисуем форму, во круг нее заливаем каким-нить цветом(например темно-зеленым) Идем в дельфу. Бросаем на форму компонент Image1 задаем ему нашу картинку. Делаем Align=alClient; В обработчике Form1.OnCreate пишим следующее:

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

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;

Нужно еще создать функцию:

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

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;

И все, теперь запускаем! Только не забудьте бросить на форму кнопку и в событии OnClick пишим close;

Теперь у меня вопрос, как можно перетаскивать форму не за заголовок???

[Romeo]

Ловить события мышки, и если мышка зажата и перемещена, то делать MoveWindow.

[LAngel]

надо быть проще...

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

TForm1...
private
  procedure HitTest(var M:TWMNCHitTest); message WM_NCHITTEST;
...

procedure TForm1.HitTest(var M:TWMNCHitTest);
begin
  inherited;
  if M.Result = HTCLIENT then M.Result := HTCAPTION;
end;

(писано на коленке, так что если где буковкой ошибся, не бейте сильно... )

[Dr_Grizzly]

Огромное СПАСИБО!!!! Братья по разуму :P

[Naeel Maqsudov]

Еще есть волшебно число $F012
То что ниже применено к Panel1 можно также и к самой форме применить.

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

-------------------------------------------------------------------------------

 8> Как таскать окно за нужный мне элемент на нём?

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
const
  SC_DragMove = $F012;  { a magic number }
begin
  ReleaseCapture;
  panel1.perform(WM_SysCommand, SC_DragMove, 0);
end;

-------------------------------------------------------------------------------

 9> Переиаскивание формы за любое её место.

procedure TForm1.WMNCHitTest(var Message : TWMNCHitTest);
begin
if PtInRegion(rgn, Message.XPos, Message.YPos) then
  Message.Result := HTCAPTION
else
  Message.Result := HTNOWHERE;
end;


-------------------------------------------------------------------------------

[fikys]

Скачай компонент MIV Skins и не парься с кодами