Delphi World - Плавающие панельки
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Плавающие панельки

Кто-нибудь пробовал создать форму, подобную "отстегивающимся" панелькам (FreeDoc)? Я попробовал и вот что получилось...

Код требует использования некоторых функций WinAPI. Описание всех WinAPI функций доступны при нажатии F1 (электронная справка)...

Ну а теперь попробуем это создать (весь код занимает около 100 строчек)...

Ход работы:

Стартуйте новый проект, задайте свойству borderstyle формы значение bsNone, добавьте панель, установите у нее свойство borderstyle равным значению bsSingle, добавьте другую панель с любым заголовком, добавьте кнопку с подсказкой 'переключатель панели заголовка', вырежьте из данного совера код и вставьте его в модуль, создайте обработчики трех событий панелей (MouseDown, MouseMove, MouseUp) и один обработчик кнопки (Click). Надеюсь, что ничего не забыл... ;-) Быстрее сделать это в Delphi, чем написать здесь... ;-)


unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    OldX,
      OldY,
      OldLeft,
      OldTop: Integer;
    ScreenDC: HDC;
    MoveRect: TRect;
    Moving: Boolean;
  public
    { Public declarations }
  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);
begin

  if Button = mbLeft then
  begin
    SetCapture(Panel1.Handle);
    ScreenDC := GetDC(0);
    OldX := X;
    OldY := Y;
    OldLeft := X;
    OldTop := Y;
    MoveRect := BoundsRect;
    DrawFocusRect(ScreenDC, MoveRect);
    Moving := True;
  end;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);
begin

  if Moving then
  begin
    DrawFocusRect(ScreenDC, MoveRect);
    OldX := X;
    OldY := Y;
    MoveRect := Rect(Left + OldX - OldLeft, Top + OldY - OldTop,
      Left + Width + OldX - OldLeft, Top + Height + OldY - OldTop);
    DrawFocusRect(ScreenDC, MoveRect);
  end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);
begin

  if Button = mbLeft then
  begin
    ReleaseCapture;
    DrawFocusRect(ScreenDC, MoveRect);
    Left := Left + X - OldLeft;
    Top := Top + Y - OldTop;
    ReleaseDC(0, ScreenDC);
    Moving := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var

  TitleHeight,
    BorderWidth,
    BorderHeight: Integer;
begin

  TitleHeight := GetSystemMetrics(SM_CYCAPTION);
  BorderWidth := GetSystemMetrics(SM_CXBORDER) + GetSystemMetrics(SM_CXFRAME) -
    1;
  BorderHeight := GetSystemMetrics(SM_CYBORDER) + GetSystemMetrics(SM_CYFRAME) -
    2;
  if BorderStyle = bsNone then
  begin
    BorderStyle := bsSizeable;
    Top := Top - TitleHeight - BorderHeight;
    Height := Height + TitleHeight + 2 * BorderHeight;
    Left := Left - BorderWidth;
    Width := Width + 2 * BorderWidth;
  end
  else
  begin
    BorderStyle := bsNone;
    Top := Top + TitleHeight + BorderHeight;
    Height := Height - TitleHeight - 2 * BorderHeight;
    Left := Left + BorderWidth;
    Width := Width - 2 * BorderWidth;
  end;
end;

end.

Коментарии

У меня есть один коментарий отностительно вышеприведенного кода: данная реализация сложней, чем она должна была быть. Все, что вы должны сделать - это обработать системное сообщение wm_NCHitTest. Я приведу здесь код, который я создал для Borland Tech Info, и который выполняет ту же функцию:


unit Dragmain;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);
begin

  inherited; { вызвали наследованный дескриптор сообщения, }
  if M.Result = htClient then { кликнув в области окна?                     }
    M.Result := htCaption; { если так, то мы заставили Windows думать,   }
  { что это область заголовка.                  }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

end.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования