Несколько советов по работе с формами

        check.gif (991 bytes) Как сделать прозрачную форму

        check.gif (991 bytes) Окно нестандартой формы

        check.gif (991 bytes) Перемещение формы, "захватывая" клиентскую часть

        check.gif (991 bytes) Ограничение размеров формы

        check.gif (991 bytes) Изображение заставки во время загрузки программы

        check.gif (991 bytes) Как заблокировать кнопку закрытия в заголовке формы

        check.gif (991 bytes) Вывод в заголовке формы текущего времени

        check.gif (991 bytes) Анимирование появления формы

        check.gif (991 bytes) Добавление пункта в системное меню формы

        check.gif (991 bytes) Создание MIDI-child формы без названия

        check.gif (991 bytes) Иммитация нажатия TAB в диалоге


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

Ключом к созданию прозрачных форм и компонентов является функция SetWindowRgn: 

unit TransparentForm;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls,
     Forms, Dialogs, StdCtrls;

type
  TTransparentForm = class(TForm)
    // это просто кнопка на форме - для демонстрации
    Button1: TButton;
  protected
    procedure RebuildWindowRgn;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  TransparentForm: TTransparentForm;

implementation

// ресурс этой формы
{$R *.DFM}

{ TTransparentForm }

constructor TTransparentForm.Create(AOwner: TComponent);
begin
  inherited;
  // убираем сколлбары, чтобы не мешались
  // при изменении размеров формы
  HorzScrollBar.Visible:= False;
  VertScrollBar.Visible:= False;
  // строим новый регион
  RebuildWindowRgn;
end;

procedure TTransparentForm.Resize;
begin
  inherited;
  // строим новый регион
  RebuildWindowRgn;
end;

procedure TTransparentForm.RebuildWindowRgn;
var FullRgn, Rgn: THandle;
    ClientX, ClientY, I: Integer;
begin
  // определяем относительные координаты клиенской части
  ClientX:= (Width - ClientWidth) div 2;
  ClientY:= Height - ClientHeight - ClientX;
  // создаем регион для всей формы
  FullRgn:= CreateRectRgn(0, 0, Width, Height);
  // создаем регион для клиентской части формы
  // и вычитаем его из FullRgn
  Rgn:= CreateRectRgn(ClientX, ClientY, ClientX + ClientWidth, ClientY +
         ClientHeight);
  CombineRgn(FullRgn, FullRgn, Rgn, rgn_Diff);
  // теперь добавляем к FullRgn регионы каждого контрольного элемента
  for I:= 0 to ControlCount -1 do
    with Controls[I] do begin
      Rgn:= CreateRectRgn(ClientX + Left, ClientY + Top, ClientX + Left +
               Width, ClientY + Top + Height);
      CombineRgn(FullRgn, FullRgn, Rgn, rgn_Or);
    end;
  // устанавливаем новый регион окна
  SetWindowRgn(Handle, FullRgn, True);
end;

end.

Окно нестандартой формы

procedure WMNCHitTest (VAR Msg : TWMNCHitTest); message WM_NCHitTEst;

procedure TForm1.WMNCHitTest; // Для перетаскивания формы
begin
  Inherited;
  if Msg.Result = htClient then Msg.Result:=htCaption;
end;

procedure TForm1.FormCreate(Sender: TObject);
var hsWindowRegion: Integer;
begin
  hsWindowRegion:=CreateEllipticRgn(40,40,700,500);
  SetWindowRgn(Handle, hsWindowRegion, True);
end;

Перемещение формы, "захватывая" клиентскую часть

В следующем примере показано как можно передвигать форму если пользователь "захватил" Client-пространство.
Наиболее простое решение - "обмануть" Windows и Client-пространство выдать за заголовок окна.


unit DragMain;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure ButtonClick(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;
end;

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

end.

Ограничение размеров формы

unit UnitMain;

interface

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

type
  TFrmRestrictSize = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    // You must handle the WM_GETMINMAXINFO message
    procedure RestrictSize(var msg: TMessage); message WM_GETMINMAXINFO;
  end;

var
  FrmRestrictSize: TFrmRestrictSize;

implementation

{$R *.DFM}

procedure TfrmRestrictSize.RestrictSize(var Msg: TMessage);
var p: PMinMaxInfo;
begin
  // The lParam contains a pointer on a structure of type TMinMaxInfo
  p := PMinMaxInfo(Msg.lParam);
  // This represents the size of the Window when Maximized
  p.ptMaxSize.x := 320;
  p.ptMaxSize.y := 240;
  // This represents the position of the Window when Maximized
  p.ptMaxPosition.x := 10;
  p.ptMaxPosition.y := 10;
  // This represents the minimum size of the Window
  p.ptMinTrackSize.x := 320;
  p.ptMinTrackSize.y := 240;
  // This represents the maximum size of the Window
  p.ptMaxTrackSize.x := 400;
  p.ptMaxTrackSize.y := 320;
end;

end.

ptMaxSize      Размер окна при его максимизации. 
ptMaxPosition  Положение левого верхнего угла окна при его максимизации. 
ptMaxTrackSize Максимальный размер окна при увеличении его размеров. 
ptMinTrackSize Минимальный размер окна при уменьшении его размеров. 

Изображение заставки во время загрузки программы

В основной файл проекта(.dpr) вносятся следующие изменения:
В отдельном модуле splash создается необходимая форма.

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  splash;  // здесь хранится форма заставки

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  SplashScreen := TSplashScreen.Create(Application);
  try
    SplashScreen.Show;
    SplashScreen.Update; {Process any pending Windows paint messages}
  finally {Make sure the splash screen gets released}
    SplashScreen.Free;
  end;
  Application.Run;
end.

Как заблокировать кнопку закрытия в заголовке формы

procedure TForm1.FormCreate(Sender: TObject); 
var hMenuHandle:HMENU; 
begin 
  hMenuHandle := GetSystemMenu(Handle, FALSE); 
  if (hMenuHandle <> 0) then begin 
    DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND); 
  end; 
end; 

Вывод в заголовке формы текущего времени

procedure TForm1.Timer1Timer(Sender: TObject);
var dc: HDC;
    cc: TCanvas;
    s: string;
begin
  dc:=GetWindowDC(Handle);
  cc:=TCanvas.Create;
  cc.Handle:=dc;
  s:=TimeToStr(time);
  cc.Brush.Color:=8388608;
  cc.Font.Size:=10;
  cc.Font.Color:=clWhite;
  cc.TextOut(Width div 2,5,s);
  ReleaseDc(Handle,dc);
end;

Анимирование появления формы

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var RecS, RecL: TRect;
begin
  RecS:= rect(0,0,0,0);
  RecL:= Form1.BoundsRect;
  DrawAnimatedRects(GetDesktopWindow, IDANI_CAPTION, RecL,RecS);
end;

procedure TForm1.FormShow(Sender: TObject);
var RecS, RecL: TRect;
begin
  RecS:= rect(0,0,0,0);
  RecL:= Form1.BoundsRect;
  { only possible with IDANI_CAPTION }
  DrawAnimatedRects(GetDesktopWindow, IDANI_CAPTION, RecS,RecL);
end;

Добавление пункта в системное меню формы

 

type
  TForm1 = class(TForm)
  . . .
    procedure HookSysCommand(var message:TWMSYSCOMMAND);message WM_SYSCOMMAND;
  end;

implementation

const
  My_MenuItem=$4000;

procedure TForm1.HookSysCommand(var message:TWMSYSCOMMAND);
begin
  inherited;
  if message.CmdType=My_MenuItem then 
    ShowMessage('Пункт активизирован');
end;

procedure TForm1.FormCreate(Sender: TObject);
var SMenu : THandle;
begin
  SMenu:=GetSystemMenu(Handle, False);
  InsertMenu(SMenu, 1, MF_Byposition, My_MenuItem, 'Новый пункт');
end;

Создание MIDI-child формы без названия

type
  TForm2 = class(TForm)
    procedure CreateParams(var Params: TCreateParams); override;
  end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and not WS_OVERLAPPEDWINDOW or WS_BORDER
end;

Иммитация нажатия TAB в диалоге

SendMessage(Form1.Handle,WM_NEXTDLGCTL,0,0);




Hosted by uCoz