FORM TOP MOST (CHANGE LORS DU RUNTIME)

unit odaMostOnTopForm;

// author : Loda
// date   : 20070524
// Descr  : Form with a system menu item "most on top". can change at runtime.

interface

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

type
  TfrmMostOnTop = class(TForm)
  private
    fMostOnTop : Boolean;
    fOldParent : TWinControl;
    fOldFormStyle : TFormStyle;
    FmiMostOnTopCaption: string;
    procedure SetMostOnTop(const Value: Boolean);
    procedure SetmiMostOnTopCaption(const Value: string);
    procedure CreateMostOnTopSysMenu;

    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;

  protected
    procedure CreateParams(var Params: TCreateParams); override;

  public
    // Operation System Most on Top (with task bar button)
    // side effect : change (and restore) form style
    property MostOnTop : Boolean read fMostOnTop write SetMostOnTop;
    // caption of system menu item. (check when MostOnTop = true)
    property miMostOnTopCaption : string read FmiMostOnTopCaption write SetmiMostOnTopCaption;

    constructor CreateMostOnTop(AOwner: TComponent; aMostOnTop : Boolean = true);
    constructor Create(AOwner: TComponent);override;
  end;


const
  SC_invMostOnTop = WM_USER + 5;

 // example of use:
 // (create a form and display it.)
 var
   frmMostOnTop : TfrmMostOnTop;

implementation

{$R *.dfm}

{ TfrmMostOnTop }

constructor TfrmMostOnTop.CreateMostOnTop(AOwner: TComponent ; aMostOnTop : Boolean);
begin
  fMostOnTop := aMostOnTop; // will be apply in CreateParam
  Create(AOwner);
end;

constructor TfrmMostOnTop.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fOldFormStyle := FormStyle;
  FmiMostOnTopCaption := 'Most on Top';
  CreateMostOnTopSysMenu;
end;

procedure TfrmMostOnTop.CreateParams(var Params: TCreateParams);
begin
  inherited;
{DOC:
for a OS Most on Top form:
Form style MUST be fsStayOnTop
ParentWindows MUST be Desktop
ExStyle MUST be TOPMost}
  if fMostOnTop then begin
    Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW or WS_EX_TOPMOST;
    Params.WndParent := GetDesktopWindow;
  end;
end;

procedure TfrmMostOnTop.WMSysCommand(var Msg: TWMSysCommand);
begin
 if Msg.CmdType = SC_invMostOnTop then begin
   MostOnTop := not fMostOnTop;
 end else
   inherited;
end;
procedure TfrmMostOnTop.CreateMostOnTopSysMenu;
var
  SysMenu : HMenu;
begin

  // reset it (prevent multiple add (when change caption))
  SysMenu := GetSystemMenu(Handle, true) ;
  // Get system menu
  SysMenu := GetSystemMenu(Handle, false) ;

  {add our menu}
  if fMostOnTop then
    InsertMenu(SysMenu,SC_CLOSE,MF_STRING or MF_Checked or MF_BYCOMMAND,SC_invMostOnTop,pchar(FmiMostOnTopCaption))
  else
    InsertMenu(SysMenu,SC_CLOSE,MF_STRING or MF_BYCOMMAND,SC_invMostOnTop,pchar(FmiMostOnTopCaption));

  {Add a seperator bar}
  InsertMenu(SysMenu,SC_CLOSE,MF_SEPARATOR or MF_BYCOMMAND,0,'');

  // see SetMenuItemBitmaps to change check mark
end;

procedure TfrmMostOnTop.SetMostOnTop(const Value: Boolean);
begin
  if value = fMostOnTop then exit;

  fMostOnTop := Value;

  if value then begin

    fOldParent := Parent;
    Parent := nil;

    fOldFormStyle := FormStyle;
    FormStyle := fsStayOnTop;

  end else begin

    Parent := fOldParent;

    formStyle := fOldFormStyle;

  end;

  DestroyHandle;
  HandleNeeded; // Apply the Most On Top  (call CreateParam)

  UpdateControlState; //refresh the form

  // recreate the system menu, cause destryhandle&friends reset it.
  CreateMostOnTopSysMenu;

end;

procedure TfrmMostOnTop.SetmiMostOnTopCaption(const Value: string);
begin
  if value = FmiMostOnTopCaption then exit;
  FmiMostOnTopCaption := Value;
  CreateMostOnTopSysMenu;
end;

end.

Télécharger le zip

25 mai 2007 09:26:54 :

ajoute le zip. ajoute la var.