Soyez le premier à donner votre avis sur cette source.
Vue 6 004 fois - Téléchargée 368 fois
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.
12 sept. 2007 à 00:53
Voila le code a rajouter dans chaque form...
___________________________
private
{ Déclarations privées }
protected
procedure CreateParams(var Params: TCreateParams); override;
public
{ Déclarations publiques }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
procedure TForm2.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
Params.WndParent := GetDesktopWindow;
end;
______________________________
28 mai 2007 à 09:11
bon la prochaine fois, je me rappelais:
- le zip de toute façon.
- plutôt un snip qu'une source en cas de doute.
A+
27 mai 2007 à 03:24
je chipotte hein ...
et quand tu as un code court qui mets en oeuvre un simple tout petit bout de code, fait plutot un snip sur codyx :)
25 mai 2007 à 09:14
ouai, pas de blem. (en fait j'avais PAS mis de zip car c'est petit et un copier coller me semblais plus simple. mais pourquoi pas les deux!)
@Foxi:
c'est juste. j'avais jamais fait gaffe.
comme d'ab, des commentaires intéressants. :)
correction dans 5min ....
A+
25 mai 2007 à 04:32
most on top =/= Topmost
TopMost = le plus au-dessus
most on top = (ne veux pas dire grand chose en fait)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.