Delphi Pages Forums  

Go Back   Delphi Pages Forums > Delphi Forum > General

Lost Password?

Reply
 
Thread Tools Display Modes
  #1  
Old 05-18-2005, 12:07 PM
douglas douglas is offline
Senior Member
 
Join Date: Jul 2001
Posts: 7,695
Default How to make external application stay on top

I need to shell execute to start another application. That is no problem. However, I need to set the other application so that it's window is always on top (stayontop). Not just bring to front, but to ALWAYS stay on top.

Anyone know how to do this?

A point waiting for ya!

Jon
Reply With Quote
  #2  
Old 05-18-2005, 12:32 PM
BaraoZemo BaraoZemo is offline
Senior Member
 
Join Date: Nov 2001
Posts: 3,598
Default RE: How to make external application stay on top

- put a timer in your form
- execute the external command and get the handle of the window and active the timer
- in the timer event, force the "topmost" of your external application using this routine

Code:
var
myExternalApp:HWND;  //this is a global variable

procedure TForm1.Timer1Timer(Sender: TObject);
begin;
SetWindowPos(myExternalApp, HWND_TOPMOST, 0, 0, 0, 0,
                            SWP_NOMOVE or SWP_NOSIZE);
end;
Regards
BaraoZemo

ps, donīt forget to Accept as Answer if this helped you!
Reply With Quote
  #3  
Old 05-18-2005, 12:34 PM
douglas douglas is offline
Senior Member
 
Join Date: Jul 2001
Posts: 7,695
Default RE: How to make external application stay on top

You can do this using the setwindowpos routine in the WinAPI

UnSYsApps

procedure TForm1.Button1Click(Sender: TObject);
var
currhwnd: HWND;
newhwnd : HWND;
counter : Integer;
begin
currhwnd:= GetForegroundWindow;
If ShellExecute( handle, Nil, 'calc.exe', Nil, Nil,
SW_SHOWNORMAL ) > 32
Then Begin
counter := 0;
Repeat
Sleep(100);
newhwnd := GetForegroundWindow;
If (newhwnd <> 0) and (newhwnd <> currhwnd) Then Begin
SetWindowPos( newhwnd, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE );
counter := 20;
End
Else
Inc( counter );
Until counter >= 20;
End;
end;
Reply With Quote
  #4  
Old 05-18-2005, 12:59 PM
douglas douglas is offline
Senior Member
 
Join Date: Jul 2001
Posts: 7,695
Default RE: How to make external application stay on top

Both those example sort of work, but they constantly give the other application focus, which I don't want. I want the other app to behave like a fsstayontop window that stays on top even if it does not have focus so that I can enter data into a background app whilst the stayontop app is still visible.

Jon
Reply With Quote
  #5  
Old 05-18-2005, 02:13 PM
AceOmega AceOmega is offline
Senior Member
 
Join Date: Sep 2004
Posts: 2,393
Default RE: How to make external application stay on top

What you are asking for can be done but not easy. You will need to make your form read only so that it does not automatically get focus with a mouse click. Then you will need it to get the keys that are pressed on the keyboard from the register and populate your TMemo programatically.

I used a Third PArty Free ware component called Hotkey Manager to do this.

http://www.delphi32.com/vcl/5308/

I made a tray program that monitors the keys pressed wile I am in other applications and it starts a program if I press the right key combination. Not exactly what you want but it should get you down the right track. Here is my tray programs code. I hope this helps...

unit Main2;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls,
ComCtrls, HotKeyManager, Menus, ExtCtrls, Buttons, shellAPI, SCList,
Just1_32, Graphics;

type
TMainForm = class(TForm)
GroupBox4: TGroupBox;
HotKeyManager1: THotKeyManager;
TrayAppTimer: TTimer;
TrayMenu: TPopupMenu;
Restore1: TMenuItem;
Close1: TMenuItem;
Panel1: TPanel;
Panel2: TPanel;
BitBtn1: TBitBtn;
Panel3: TPanel;
BtnRemove: TButton;
BtnClear: TButton;
Panel4: TPanel;
Panel5: TPanel;
GroupBox2: TGroupBox;
Label2: TLabel;
BtnGetHotKey: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
ComboBox1: TComboBox;
GroupBox3: TGroupBox;
BtnTextToHotKey: TButton;
Edit1: TEdit;
BtnTest: TButton;
GroupBox1: TGroupBox;
Button1: TButton;
AssignedFileEdit: TEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
JustOne321: TJustOne32;
ListBox1: TSCListBox;
ListBox2: TSCListBox;
SpeedButton1: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnGetHotKeyClick(Sender: TObject);
procedure BtnTextToHotKeyClick(Sender: TObject);
procedure BtnTestClick(Sender: TObject);
procedure BtnRemoveClick(Sender: TObject);
procedure BtnClearClick(Sender: TObject);
procedure HotKeyManager1HotKeyPressed(HotKey: Cardinal; Index: Word);
procedure BitBtn1Click(Sender: TObject);
procedure TrayAppTimerTimer(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBox1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure Button1Click(Sender: TObject);
procedure ListBox1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ListBox1Click(Sender: TObject);
procedure ListBox2KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure ListBox2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
procedure AddHotKey(HotKey: Cardinal);
procedure GetPotentialKeys;
procedure AppMessageEvent(var Msg: TMsg; var Handled: Boolean);
procedure WndProc(var Msg:TMessage);Override;
public
{ Public declarations }
Icondata:TNotifyIconData; //Tray App
IconCount:Integer; //Tray App
end;

var
MainForm: TMainForm;

implementation

{$R *.DFM}

const
LOCALIZED_KEYNAMES = True;

type
THotKeyEntry = class
HotKey: Cardinal;
constructor Create(iHotKey: Cardinal);
end;

TPotentialKey = class
Key: Word;
constructor Create(iKey: Word);
end;

constructor THotKeyEntry.Create(iHotKey: Cardinal);
begin
inherited Create;
HotKey := iHotKey;
end;

constructor TPotentialKey.Create(iKey: Word);
begin
inherited Create;
Key := iKey;
end;

{--------------------- TMainForm ----------------------}

procedure TMainForm.AddHotKey(HotKey: Cardinal);
begin
if HotKeyManager1.AddHotKey(HotKey) <> 0 then
begin
ListBox1.Items.AddObject(HotKeyToText(HotKey, LOCALIZED_KEYNAMES), THotKeyEntry.Create(HotKey));
Listbox2.Items.Add('');
Listbox2.ItemIndex := Listbox2.Items.Count-1;
Listbox1.ItemIndex := Listbox1.Items.Count-1;
//HotKey1.HotKey := 0; // Just a nice touch
end
else
MessageDlg(HotKeyToText(HotKey, LOCALIZED_KEYNAMES) + ' couldn''t be assigned to a hotkey.',
mtWarning, [mbOk], 0);
end;


procedure TMainForm.AppMessageEvent(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.message = wm_SysCommand) and ((Msg.WParam and $FFF0) = $100) then
begin
ShowMessage('About this program - '+#13+' handled at the Application level');
Handled:=true;
end
else
inherited;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
hSysMenu: HMENU;
begin

{API for setting up tray icons}
IconCount:=0;
IconData.cbSize:=sizeof(IconData);
IconData.Wnd:= Handle;
IconData.uID:=100;
IconData.uFlags:= NIF_Message or NIF_Icon or NIF_TIP;
IconData.uCallbackMessage:=WM_User + 1;
IconData.hIcon:= LoadIcon(HInstance,'MAINICON');
StrPCopy(IconData.szTip, Application.Title);
Shell_NotifyIcon(NIM_ADD,@IconData);

Application.OnMessage:=AppMessageEvent;
// Add this item to the Application's System Menu
hSysMenu := getSystemMenu(Application.handle, false );
AppendMenu( hSysmenu, MF_STRING, $100, 'About...' );

// Add this item to the Form's System Menu
hSysMenu := getSystemMenu(handle, false );
AppendMenu( hSysmenu, MF_SEPARATOR, 0, '');
AppendMenu( hSysmenu, MF_STRING, $100, 'About...' );

GetPotentialKeys;
MainForm.Hide;
TrayAppTimer.enabled :=true;

end;


procedure TMainForm.FormDestroy(Sender: TObject);
var
I: Integer;
begin
for I := ComboBox1.Items.Count -1 downto 0 do
ComboBox1.Items.Objects[I].Free;

Shell_NotifyIcon(NIM_DELETE,@IconData); //Removes Icon From The Tray
end;


procedure TMainForm.BtnGetHotKeyClick(Sender: TObject);
var
HotKeyVars: Cardinal;
Modifiers: Word;
PotentialKey: TPotentialKey;
begin
Modifiers := 0;
if CheckBox1.Checked then
Modifiers := Modifiers or MOD_CONTROL;
if CheckBox2.Checked then
Modifiers := Modifiers or MOD_SHIFT;
if CheckBox3.Checked then
Modifiers := Modifiers or MOD_ALT;
if CheckBox4.Checked then
Modifiers := Modifiers or MOD_WIN;
if ComboBox1.ItemIndex <> -1 then
begin
PotentialKey := (ComboBox1.Items.Objects[ComboBox1.ItemIndex] as TPotentialKey);
HotKeyVars := HotKeyManager.GetHotKey(Modifiers, PotentialKey.Key); {}
AddHotKey(HotKeyVars);{}

end
else
MessageDlg('No key selected from the list.', mtWarning, [mbOk], 0);
end;


procedure TMainForm.BtnTextToHotKeyClick(Sender: TObject);
var
HotKeyVar: Cardinal;
begin
HotKeyVar := TextToHotKey(Edit1.Text, LOCALIZED_KEYNAMES);
if HotKeyVar <> 0 then
AddHotKey(HotKeyVar)
else
MessageDlg(Edit1.Text + ' doesn''t appear to be a hotkey.', mtWarning, [mbOk], 0);
end;


procedure TMainForm.BtnTestClick(Sender: TObject);
var
HotKeyVar: Cardinal;
S1: String;
begin
HotKeyVar := TextToHotKey(Edit1.Text, LOCALIZED_KEYNAMES);
if HotKeyVar <> 0 then
begin
S1 := '';
if not HotKeyAvailable(HotKeyVar) then
S1 := 'NOT ';
MessageDlg(HotKeyToText(HotKeyVar, LOCALIZED_KEYNAMES) + ' is ' + S1 +
'available for registration.', mtInformation, [mbOk], 0);
end
else
MessageDlg(Edit1.Text + ' doesn''t appear to be a hotkey.', mtWarning, [mbOk], 0);
end;


procedure TMainForm.BtnRemoveClick(Sender: TObject);
var
HotKeyEntry: THotKeyEntry;
begin
if ListBox1.ItemIndex > -1 then
begin
HotKeyEntry := (ListBox1.Items.Objects[ListBox1.ItemIndex] as THotKeyEntry);
if HotKeyManager1.RemoveHotKey(HotKeyEntry.HotKey) then
begin
HotKeyEntry.Free;
ListBox2.Items.Delete(ListBox1.ItemIndex);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end
else
MessageDlg(HotKeyToText(HotKeyEntry.HotKey, LOCALIZED_KEYNAMES) +
' couldn''t be removed.', mtWarning, [mbOk], 0);
end;
end;


procedure TMainForm.BtnClearClick(Sender: TObject);
var
I: Integer;
begin
HotKeyManager1.ClearHotKeys;
//HotKey1.HotKey := 0;
for I := 0 to ListBox1.Items.Count -1 do
(ListBox1.Items.Objects[I] as THotKeyEntry).Free;
ListBox1.Items.Clear;
ListBox2.Items.Clear;
end;


procedure TMainForm.HotKeyManager1HotKeyPressed(HotKey: Cardinal; Index: Word);
var
ListIndex : Integer;
begin
SetForegroundWindow(Application.Handle);
ListIndex := Listbox1.Items.IndexOf(HotKeyToText(HotKey, LOCALIZED_KEYNAMES));
MessageDlg('Hotkey = '+ ListBox2.Items[ListIndex],
mtInformation, [mbOk], 0);
end;


procedure TMainForm.GetPotentialKeys;

procedure AddKeys(Min, Max: Word);
var
I: Integer;
KeyName: String;
begin
for I := Min to Max do
begin
KeyName := HotKeyToText(I, LOCALIZED_KEYNAMES);
if KeyName <> '' then
ComboBox1.Items.AddObject(KeyName, TPotentialKey.Create(I));
end;
end;

begin
// Add standard keys
AddKeys($08, $09);
AddKeys($0D, $0D);
AddKeys($14, $91);
AddKeys($BA, $FF);
// Add extended keys
AddKeys(_VK_BROWSER_BACK, _VK_LAUNCH_APP2);
if ComboBox1.Items.Count > 0 then
ComboBox1.ItemIndex := 0;
end;

procedure TMainForm.BitBtn1Click(Sender: TObject);
begin
MainForm.Hide;
end;

procedure TMainForm.TrayAppTimerTimer(Sender: TObject);
begin
Application.Title:= 'Tray App Test';
StrPCopy(IconData.szTip,'Hello World');
Shell_NotifyIcon(NIM_MODIFY,@IconData);
end;

procedure TMainForm.WndProc(var Msg:TMessage);
var
p : TPoint;
begin
If Msg.Msg = (WM_User + 1) then
Begin
case msg.lparam of
WM_RBUTTONDOWN :
begin
GetCursorPos(p);
TrayMenu.Popup(p.x,p.y);
end;
WM_LBUTTONDBLCLK :
begin
ShowWindow(Handle, SW_ShowNormal);
SetForeGroundWindow(Handle);
Show;
end;
end; {Case}
end; {If}
inherited;
end;

procedure TMainForm.Close1Click(Sender: TObject);
begin
close;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
OpenDialog1.Execute;
AssignedFileEdit.Text := OpenDialog1.FileName;
end;

procedure TMainForm.ListBox1Scroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
ListBox2.ItemIndex := Listbox1.ItemIndex;
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
Listbox2.Items[Listbox1.ItemIndex] := AssignedFileEdit.Text;
end;

procedure TMainForm.ListBox1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Listbox2.ItemIndex := Listbox1.ItemIndex;
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
begin
Listbox2.ItemIndex := Listbox1.ItemIndex;
end;

procedure TMainForm.ListBox2KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Listbox1.ItemIndex := Listbox2.ItemIndex;
end;

procedure TMainForm.ListBox2Click(Sender: TObject);
begin
Listbox1.ItemIndex := Listbox2.ItemIndex;
end;

procedure TMainForm.FormPaint(Sender: TObject);
var
Bitmap : TBitMap;
begin
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('c:\image.bmp');
Bitmap.Height := SpeedButton1.Height-1;
Bitmap.Width := SpeedButton1.Width-1;
SpeedButton1.Glyph.Canvas.Pen.Color := clRed;
SpeedButton1.Glyph.Canvas.Brush.Color := clRed;
SpeedButton1.Glyph.Canvas.FloodFill(0,0,clBlack,fs Border);
end;

end.
Reply With Quote
  #6  
Old 06-06-2005, 08:41 AM
douglas douglas is offline
Senior Member
 
Join Date: Jul 2001
Posts: 7,695
Default RE: How to make external application stay on top

Was your question answered?

If this helps, please accept as answer!

UnSysApps
Reply With Quote
  #7  
Old 06-06-2005, 11:09 AM
douglas douglas is offline
Senior Member
 
Join Date: Jul 2001
Posts: 7,695
Default RE: How to make external application stay on top

No, doesn't do what I need.

re my previous post:

Both those example sort of work, but they constantly give the other application focus, which I don't want. I want the other app to behave like a fsstayontop window that stays on top even if it does not have focus so that I can enter data into a background app whilst the stayontop app is still visible.

Jon


Jon
Reply With Quote
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is On

Forum Jump


All times are GMT. The time now is 03:46 PM.


Powered by vBulletin® Version 3.8.8
Copyright ©2000 - 2018, vBulletin Solutions, Inc.