unit FormSystemMenuDeleteUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  上から1番目のシステムメニューを削除
//  メニュー項目の位置( MF_BYPOSITION)ではなく，メニュー名で指定する場合は
//  DeleteMenu(hSysMenu, SC_MOVE, MF_BYCOMMAND);
//  のようにする(Button3Clickイベントのコード参照)
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  hSysmenu : hMenu;
begin
  //フォームのシステムメニューのハンドルを取得
  hSysmenu := GetSystemMenu(Handle, False);
  //上から1番目のメニューを削除
  DeleteMenu(hSysMenu, 0, MF_BYPOSITION);
end;

//=============================================================================
//  上から2番目のシステムメニューを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  hSysmenu : hMenu;
begin
  //フォームのシステムメニューのハンドルを取得
  hSysmenu := GetSystemMenu(Handle, False);
  //上から2番目のメニューを削除
  DeleteMenu(hSysMenu, 1, MF_BYPOSITION);
end;

//=============================================================================
//  SC_CLOSE(閉じる)メニューを削除
//
//  参考
//  [閉じるボタン]は削除できない．非表示にもできない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  hSysmenu : hMenu;
  AItemCnt : Integer;
begin
  //フォームのシステムメニューのハンドルを取得
  hSysmenu := GetSystemMenu(Handle, False);
  //閉じるメニューを無効化
  DeleteMenu(hSysMenu, SC_CLOSE, MF_BYCOMMAND);

  //現在のメニューの項目数を取得して一番下の区切り線を削除
  AItemCnt := GetMenuItemCount(hSysmenu);
  DeleteMenu(hSysmenu, AItemCnt - 1, MF_BYPOSITION);
end;

end.

unit FormSystemMenuInsertUnit;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 
  Vcl.StdCtrls;
  {$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
  {$IFEND}

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMInitMenuPopup(var Message: TWMInitMenuPopup);
      message WM_INITMENUPOPUP;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

// 追加メニューのID値
// 値は任意の整数値
const
  MyMenu1 = 101;
  MyMenu2 = 102;
  MyMenu3 = 103;

{$R *.dfm}

//=============================================================================
//  システムメニューを追加
//  InsertMenu関数の第3引数にはいろいろ値がある
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  hSysmenu : hMenu;
  AItemCnt : Integer;
begin
  //フォームのシステムメニューのハンドルを取得
  hSysmenu := GetSystemMenu(Handle, False);

  //現在の項目数を取得
  AItemCnt := GetMenuItemCount(hSysmenu);

  //現在のメニュー一番下に区切り線(第4,5引数を0にする)を追加
  InsertMenu(hSysmenu, AItemCnt, MF_BYPOSITION, 0, nil);
  //現在のメニューの一番下にメニューを追加
  InsertMenu(hSysmenu, AItemCnt + 1, MF_BYPOSITION, MyMenu1, 'テストメニュー');
  //現在のメニューの一番下にメニューを追加
  InsertMenu(hSysmenu, AItemCnt + 2, MF_BYPOSITION, MyMenu2, 'テスト項目');

  //[移動]メニュー(SC_MOVE)の前に[追加メニュー]を追加
  //操作不可にして淡色表示に
  InsertMenu(hSysmenu, SC_MOVE, MF_BYCOMMAND or
                                MF_DISABLED  or

                                MF_GRAYED, MyMenu3, '追加メニュー');
end;

//=============================================================================
//  メニューを選択した時のメッセージ処理
//=============================================================================
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
begin
  case Message.CmdType of
    MyMenu1 : Showmessage('テストメニューです．　');
    MyMenu2 : Showmessage('テスト項目です．　');
  end;

  inherited;
end;

//=============================================================================
//  メニューを表示する時のメッセージ処理
//  追加したMyMenu1をグレイ表示にして使用不可とする
//=============================================================================
procedure TForm1.WMInitMenuPopup(var Message: TWMInitMenuPopup);
begin
   inherited;

   if Message.SystemMenu then
   begin
     EnableMenuItem(Message.MenuPopup, MyMenu1, MF_BYCOMMAND or MF_GRAYED);
   end;
end;

end.

unit CaptionBarMouseEventUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown);
      message WM_NCLBUTTONDOWN;
    procedure WMNCRButtonDown(var Message: TWMNCRButtonDown);
      message WM_NCRBUTTONDOWN;
    procedure WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk);
      message WM_NCLBUTTONDBLCLK;
    procedure WMNCMButtonDown(var Message: TWMNCMButtonDown);
      message WM_NCMBUTTONDOWN;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  マウス左ボタンダウン
//  WM_NCLBUTTONDOWNメッセージ
//=============================================================================
procedure TForm1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
begin
  Self.Color := clRed;

  //元の動作を実行
  //これを削除すれば動作無効
  inherited;
end;

//=============================================================================
//  マウス右ボタンダウン
//  WM_NCRBUTTONDOWNメッセージ
//=============================================================================
procedure TForm1.WMNCRButtonDown(var Message: TWMNCRButtonDown);
begin
  Self.Color := clGreen;

  //元の動作を実行
  //これを削除すれば動作無効
  inherited;
end;

//=============================================================================
//  マウス左ボタンダブルクリック
//  inheritedを削除して元の動作(最大化と元のサイズに戻すを無効に
//  WM_NCLBUTTONDBLCLKメッセージ
//=============================================================================
procedure TForm1.WMNCLButtonDblClk(var Message: TWMNCLButtonDblClk);
begin
  Self.Color := clBlue;
end;

//=============================================================================
//  マウス中央(ホイール)ボタンダウン
//  WM_NCMBUTTONDOWNメッセージ
//=============================================================================
procedure TForm1.WMNCMButtonDown(var Message: TWMNCMButtonDown);
begin
  Self.Color := clYellow;

  //元の動作を実行
  //これを削除すれば動作無効
  inherited;
end;

end.

unit FormShowingChangedUnit;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 
  Vcl.StdCtrls, Vcl.ExtCtrls;
  {$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
  {$IFEND}

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure CMShowingchanged(var Message: TMessage);
      message CM_SHOWINGCHANGED;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  フォーム表示後のメッセージ
//
//  CM_SHOWINGCHANGEDメッセージを処理する
//  CM_SHOWINGCHANGEDは表示の状態が変化した時に発生する
//  非表示になる時も発生するので，Visibleプロパティで判断する
//=============================================================================
procedure TForm1.CMShowingchanged(var Message: TMessage);
begin
  //元のメッセージを処理
  inherited;

  if Visible then begin
    Update;
    //表示後の処理
    ShowMessage('フォーム表示終了しました．　');
  end;
end;

//=============================================================================
//  フォーム表示中のイベント
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  ShowMessage('フォーム表示中です．　');
end;

end.

unit GradientFormUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses GraphUtil;

{$R *.dfm}

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  フォームの背景をグラデーションに
//  フォームのCanvasに描画したものはOnPaintに描画しないと他のウィンドウに隠され
//  た際に消去されてしまう
//  そこで，このサンプルでは，OnPaintで処理して，常に描画が行われるようにして
//  いる
//
//  usesにGraphUtilが必要
//  AEndColorをclGradientInactiveCaptionにするとデフォルトのグラデーション配色,
//=============================================================================
procedure TForm1.FormPaint(Sender: TObject);
var
  Rect: TRect;
begin
　Rect := Self.ClientRect;
　GradientFillCanvas(Canvas, clWhite, clBlue, Rect, gdVertical);
end;

end.

unit FormColseMessageUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ApplicationEvents1: TApplicationEvents;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ApplicationEvents1Activate(Sender: TObject);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
    procedure ApplicationEvents1ShortCut(var Msg: TWMKey; var Handled: Boolean);
  private
    { Private 宣言 }
    SL : TStringList;
  protected
    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;
    procedure WMQueryEndSession(var Message: TWMQueryEndSession);
      message WM_QUERYENDSESSION;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  TStringList作成
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
   SL := TStringList.Create;
end;

//=============================================================================
//  FormのOnCloseQuery
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  SL.Add('OnCloseQuery');
end;

//=============================================================================
//  FormのOnClose
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SL.Add('OnClose');
end;

//=============================================================================
//  記録内容をファイルに保存
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  SL.Add('OnDestroy');
  SL.SaveToFile('Close.txt');
  FreeAndNil(SL);
end;

//=============================================================================
//  [Close]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  [WM_CLOSE]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
   PostMessage(Handle, WM_CLOSE, 0, 0);
end;

//=============================================================================
//  [Terminate]ボタン
//  OnDestroyしか発生しない
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  Application.Terminate;
end;

//=============================================================================
//  TApplicationEvetnコンポのOnActivate
//=============================================================================
procedure TForm1.ApplicationEvents1Activate(Sender: TObject);
begin
  SL.Add('TApplicationEvent OnActivate');
end;

//=============================================================================
//  TApplicationEvetnコンポのOnDeactivate
//=============================================================================
procedure TForm1.ApplicationEvents1Deactivate(Sender: TObject);
begin
  SL.Add('TApplicationEvent OnDeactivate');
end;

//=============================================================================
//  TApplicationEvetnコンポのOnShortCut
//
//  ショートカット動作の検出
//  ここでは[Alt]+[F4]だけを調べる
//=============================================================================
procedure TForm1.ApplicationEvents1ShortCut(var Msg: TWMKey;
  var Handled: Boolean);
var
     SS : TShiftState;
Begin
  SS := KeyDataToShiftState(Msg.KeyData);
  if (Msg.CharCode=VK_F4) and (ssAlt in SS) then begin
    SL.Add('[Alt]+[F4]');
  end;
end;

//=============================================================================
//  WM_SYSCOMMANDメッセージ
//  [Close]ボタンで終了した時は発生しない
//=============================================================================
procedure TForm1.WMSysCommand(var Message: TWMSysCommand);
var
  AType : Integer;
begin
   AType :=Message.CmdType and $FFF0;

   if AType = SC_CLOSE then begin
     SL.Add('SC_CLOSE');
   end else
   if AType = SC_MOUSEMENU then begin
     SL.Add('SC_MOUSEMENU');
   end else
   if AType = SC_KEYMENU then begin
     SL.Add('SC_KEYMENU');
   end;

   inherited;
end;

//=============================================================================
//  WM_QUERYENDSESSIONメッセージ
//  Windowsを終了する時に発生するメッセージ
//=============================================================================
procedure TForm1.WMQueryEndSession(var Message: TWMQueryEndSession);
begin
  SL.Add('WM_QUERYENDSESSION');

  //終了させる
  Message.Result := 1;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  [Alt]+[F4]でフォームを閉じるのを禁止
//  TApplicationのOnMessageでメッセージ処理する場合
//  Handled := Trueにするとメッセージ送信しないことを利用
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if  (Msg.message = WM_SYSKEYDOWN) then begin
    if (Msg.wParam = VK_F4) and (GetKeyState(VK_MENU) < 0) then begin
      Handled := True;
    end;
  end;
end;

end.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
  private
    { Private 宣言 }
    procedure WMSysKeyDown(var Msg : TWMSysKeyDown); Message WM_SYSKEYDOWN;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  [Alt]+[F4]でフォームを閉じるのを禁止
//  WM_SYSKEYDOWNを使用した例
//=============================================================================
procedure TForm1.WMSysKeyDown(var Msg: TWMSysKeyDown);
begin
  //Alt+F4が押された場合
  if (Msg.CharCode = VK_F4) then begin
    //[Shift]と[Ctril]キーが同時に押されている場合は通常(inherited)動作とする
    if (ssShift in KeyDataToShiftState(Msg.KeyData)) or
       (ssCtrl in KeyDataToShiftState(Msg.KeyData)) then begin
      inherited
    end;
  end else begin
    inherited;
  end;
end;

end.

unit Unit1;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, 
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.AppEvnts;
  {$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, AppEvnts;
  {$IFEND}

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  protected
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown);
      message WM_NCLBUTTONDOWN;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  [Close]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  WM_NCLBUTTONDOWNメッセージの処理
//  WM_NCLBUTTONDOWNは非クライアント領域でのマウスの左ボタンダウンメッセージ
//  マウスのボタンダウンの検出はWM_NCRBUTTONDOWNメッセージを使用する
//=============================================================================
procedure TForm1.WMNCLButtonDown(var Message: TWMNCLButtonDown);
var
  LHitTest : Integer;
  LText    : String;
begin
  LHitTest := Message.HitTest;

  if LHitTest = HTCLOSE then begin
    LText := 'x ボタンが押されました' + sLineBreak + '本当に閉じますか';
    if MessageBox(Handle, PChar(LText), '確認', MB_YESNO) = IDYES then begin
      //inherited;だとダイアログのWM_NCLBUTTONDOWNメッセージが発生するので閉じない
      Close;
    end else begin
      Message.Result := 0;
    end;
  end else
  if LHitTest = HTMINBUTTON then begin
    ShowMessage('最小化ボタンは機能しません');
    Message.Result := 0;
  end else
  if LHitTest = HTMAXBUTTON then begin
    Width    := 300;
    Height   := 300;
    Position := poDesktopCenter;
    Message.Result := 0;
  end else
  if LHitTest = HTSYSMENU then begin
    LText := 'システムメニュー (アプリケーション) アイコンが押されました' + sLineBreak
           + 'マウスの左ボタンではメニューを表示しないようにしています' + sLineBreak
           + 'システムメニューを表示するにはマウスの右ボタンを押してください';
    MessageBox(Handle, PChar(LText), '確認', MB_OK);
    Message.Result := 0;
  end else begin
    inherited;
  end;
end;

end.

//=============================================================================
//  [Close]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  ApplicationEvents1 の OnMessage イベント処理
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  LMsg     : Cardinal;
  LHitTest : Integer;
begin
  LMsg := Msg.message;

  // マウスの右と左のどちらのボタン押下でもシステムメニューを表示しない
  if (LMsg = WM_NCLBUTTONDOWN) or (LMsg = WM_NCRBUTTONDOWN) then begin
    LHitTest := Msg.wParam;
    if LHitTest = HTSYSMENU then begin
      Handled := True;
    end;
  end;

  // [Alt] キーと同時に VKF4 が押されている時は無効にする
  if (LMsg = WM_SYSKEYDOWN) then begin
    if (Msg. wParam = VK_F4) then begin
      Handled := True;
    end;
  end;

  // 閉じるボタンでは閉じないようにする
  // 最小化ボタンで最小化できないようにする
  // 最大化ボタンで最大化できないようにする
  if LMsg = WM_NCLBUTTONDOWN then begin
    LHitTest := Msg.wParam;
    if LHitTest = HTCLOSE then begin
      Handled := True;
    end else
    if (LHitTest = HTMINBUTTON) or (LHitTest = HTMAXBUTTON) then begin
      Handled := True;
    end;
  end;

  // Caption バーのダブルクリックの操作を無効にする
  // つまり最大化できない
  if LMsg = WM_NCLBUTTONDBLCLK then begin
    LHitTest := Msg.wParam;
    if LHitTest = HTCAPTION then begin
      Handled := True;
    end;
  end;
end;

//=============================================================================
//  [Close]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  フォームのOnCloseQueryイベント処理
//=============================================================================
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if MessageBox(Handle, '本当に閉じますか', '確認', MB_YESNO) = IDYES then begin
    CanClose := True;
  end else begin
    CanClose := False;
  end;
end;

  //このフォームを最前面にする
  SetWindowPos(Self.Handle,
               HWND_TOPMOST,
               0,
               0,
               0,
               0,
               SWP_NOMOVE or SWP_NOSIZE);

unit TopMostFormUnit;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    OriginalProc:TWndMethod;
    procedure SubClassProc(var Message:TMessage);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  元のWindowsProcを退避して新しいWindowProcを定義
//  この設定は用途によってはOnShowで設定する必要があるかも知れない
//  OnShow設定の場合は，OnCloseでWindowProcを元に戻しておいた方がいいだろう
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalProc    := Self.WindowProc;
  Self.WindowProc := SubClassProc;
end;
//=============================================================================
//  WindowsProcを元に戻しておく
//  このサンプルではOnCreateでWindowProcを設定しているので実際には不要
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  Self.WindowProc := OriginalProc;
end;
//=============================================================================
//  WindowProcのサブクラス関数
//  このフォームがZオーダのトップかを監視して設定
//=============================================================================
procedure TForm1.SubClassProc(var Message: TMessage);

  //Targetが最前面かを判定する関数
  function IsTopMost(Target: HWND): boolean;
  begin
    Result := ((GetWindowLong(Target, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0);
  end;
  //---------------------------------------------------------------------------

begin
  //元のWindowProcを実行
  OriginalProc(Message);

  //このフォームが最前面でなければ最前面にする
  if IsTopMost(Self.Handle)=False then begin
    SetWindowPos(Self.Handle,
                 HWND_TOPMOST,
                 0,
                 0,
                 0,
                 0,
                 SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOOWNERZORDER);
  end;
end;

end.

unit OverLapMainUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses OverLapForm;

//=============================================================================
//  位置を指定してForm2を表示
//  Form2のPositionプロパティはpoDesigned
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  APos : TPoint;
begin
  APos := Point(Edit1.Left, Edit1.Top + Edit1.Height);
  APos := Form1.ClientToScreen(APos);

  Form2.Left := APos.X;
  Form2.Top  := APos.Y;

  Form2.Show;
end;

end.

unit OverLapForm;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, 
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
  {$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
  {$IFEND}

type
  TForm2 = class(TForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form2: TForm2;

implementation

{$R *.DFM}

uses OverLapMainUnit;

//=============================================================================
//  オーバーラップなフローティングウィンドウにする
//  このフォームを表示した後，Form1にフォーカス移動してもこのフォームはForm1の
//  前面に表示される
//
//  このフォームのPositionプロパティはpoDesigned
//=============================================================================
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Params.Style     := Params.Style or WS_OVERLAPPED;
  Params.WndParent := Form1.Handle;
end;

end.

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Params.Style     := WS_OVERLAPPED or WS_POPUP or WS_THICKFRAME;
  Params.WndParent := Form1.Handle;
end;

procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Params.Style     := WS_OVERLAPPED or WS_POPUP or WS_BORDER;
  Params.WndParent := Form1.Handle;
end;

unit Unit1;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
  {$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
  {$IFEND}

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム作成時の処理
//  現在の設定状態をチェックボックスの状態に反映
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  WindowStyle : Longint;
begin
  //現在のスタイルの設定値を取得
  WindowStyle := GetWindowLong(Form1.Handle, GWL_STYLE);

  //スタイル値に応じてチェックボックスのチェック状態を変更
  if (WindowStyle and WS_CAPTION) > 0     then CheckBox1.Checked := True;
  if (WindowStyle and WS_BORDER) > 0      then CheckBox2.Checked := True;
  if (WindowStyle and WS_THICKFRAME) > 0  then CheckBox3.Checked := True;
  if (WindowStyle and WS_POPUP) > 0       then CheckBox4.Checked := True;
  if (WindowStyle and WS_SYSMENU) > 0     then CheckBox5.Checked := True;
  if (WindowStyle and WS_MAXIMIZEBOX) > 0 then CheckBox6.Checked := True;
  if (WindowStyle and WS_MINIMIZEBOX) > 0 then CheckBox7.Checked := True;

  //全てのチェックボックスのOnClickは共通して使用
  //実際にはオブジェクト・インスペクタで設定した方が良
  CheckBox1.OnClick := CheckBox1Click;
  CheckBox2.OnClick := CheckBox1Click;
  CheckBox3.OnClick := CheckBox1Click;
  CheckBox4.OnClick := CheckBox1Click;
  CheckBox5.OnClick := CheckBox1Click;
  CheckBox6.OnClick := CheckBox1Click;
  CheckBox7.OnClick := CheckBox1Click;
end;

//=============================================================================
//  チェックボックスのチェック状態によってフォームのスタイルを変更
//  最小化・最大化・閉じるボタンはキャプションバーが表示されていなければ表示さ
//  ないことに注意
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
var
  WindowStyle : Longint;
begin
  //現在のスタイルの設定値を取得
  WindowStyle := GetWindowLong(Form1.Handle, GWL_STYLE);

  //WS_CAPTIONたけを設定してもキャプションバー(タイトルバー)は表示されない
  //WS_BORDERの値も必要
  if (CheckBox1.Checked) then begin
    WindowStyle := WindowStyle or WS_CAPTION;
  end else begin
    WindowStyle := WindowStyle and not WS_CAPTION;
  end;

  if (CheckBox2.Checked) then begin
    WindowStyle := WindowStyle or WS_BORDER;
  end else begin
    WindowStyle := WindowStyle and not WS_BORDER;
  end;

  if (CheckBox3.Checked) then begin
    WindowStyle := WindowStyle or WS_THICKFRAME;
  end else begin
    WindowStyle := WindowStyle and not WS_THICKFRAME
  end;

  if (CheckBox4.Checked) then begin
    WindowStyle := WindowStyle or WS_POPUP;
  end else begin
    WindowStyle := WindowStyle and not WS_POPUP;
  end;

  if (CheckBox5.Checked) then begin
    WindowStyle := WindowStyle or WS_SYSMENU;
  end else begin
    WindowStyle := WindowStyle and not WS_SYSMENU;
  end;

  if (CheckBox6.Checked) then begin
    WindowStyle := WindowStyle or WS_MAXIMIZEBOX;
  end else begin
    WindowStyle := WindowStyle and not WS_MAXIMIZEBOX;
  end;

  if (CheckBox7.Checked) then begin
    WindowStyle := WindowStyle or WS_MINIMIZEBOX;
  end else begin
    WindowStyle := WindowStyle and not WS_MINIMIZEBOX;
  end;

  //スタイル変更を実行
  SetWindowLong(Form1.Handle, GWL_STYLE, WindowStyle);
  //再描画のため必要(非クライアント領域を含めてウィンドウを再描画)
  SetWindowPos(Handle, 0, 0, 0, 0, 0,
               SWP_DRAWFRAME  or
               SWP_NOACTIVATE or
               SWP_NOMOVE     or
               SWP_NOSIZE     or
               SWP_NOZORDER);
end;

end.

unit ShowTaskBarIconUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses AnotherForm;

{$R *.dfm}

//=============================================================================
//  Form2を表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Left := Self.Left - Self.Width - 20;
  Form2.Top  := Self.Top - Self.Height - 20;
  Form2.Show;
end;

//=============================================================================
//  [終了]ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.

unit AnotherForm;

interface

uses
  {$IF CompilerVersion > 22.99}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
  {$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
  {$IFEND}

type
  TForm2 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  protected
    procedure CreateParams(var Params : TCreateParams); override;
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

{ TForm2 }

//=============================================================================
//  フォームのCreateParams処理
//=============================================================================
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  //このフォームの親はDesktopとする
  //タスクバーにForm1とは別にアイコン表示される
  Params.WndParent := GetDesktopWindow;
end;

//=============================================================================
//  このフォームのアイコンを変更
//  当然タスクバーのアイコンも変わる
//=============================================================================
procedure TForm2.Button1Click(Sender: TObject);
begin
  Self.Icon.LoadFromFile('32_8bit.ico');
  SetClassLong(Handle, GCL_HICON, Self.Icon.Handle);
end;

end.

//=============================================================================
//  このフォームを閉じる
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  PostMessage(Handle, WM_CLOSE, 0, 0);
end;

//=============================================================================
//  このフォームを閉じる
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
begin
  PostMessage(Handle, WM_CLOSE, 0, 0);
end;