Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

App without FORM.

Posted on 2000-04-26
15
Medium Priority
?
242 Views
Last Modified: 2010-08-05
I need to build an app that will be as small as possible. I am using a coupla components, but I don't need to use forms. On the other hand, I need to somehow do the message loop for this formless app. How to do that? pleas give my code
0
Comment
Question by:ILPowerSoft
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
  • 2
  • +6
15 Comments
 
LVL 3

Expert Comment

by:shenqw
ID: 2752244
procedure MessageLoop;
var
  Msg: TMsg;
  FTerminate:boolean;
begin
  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      if Msg.Message <> WM_QUIT then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end
      else
        FTerminate := True;
    end;
  until FTerminate;
end;
0
 

Expert Comment

by:fredff13
ID: 2752373
You should create new Application, then remove Form1 from the project. That's it. Below example looping message 3 times and then programs terminated:

program Project1;

uses
  Forms, Windows;
{$R *.RES}

procedure MessageLoop;
var
  i   : byte;
begin
  for i := 1 to 3 do
     Application.MessageBox( 'Message', 'Info', MB_OK );
  Application.Terminate;
end;

begin
  Application.Initialize;
  Application.Run;
  MessageLoop;
end.
 
0
 
LVL 3

Expert Comment

by:shenqw
ID: 2752532
if you use Application.the exe file size >200KB. don't use Application Object  then the filesize<20k
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Expert Comment

by:fredff13
ID: 2752934
It's 274k. How do not use Application Object, if I need to run and then terminate prog? Is there other way?
0
 
LVL 3

Accepted Solution

by:
shenqw earned 400 total points
ID: 2754147
//It maybe not be standard,but it works. this test project size is 290k.
//That said if you use component ,you exe file will very big.
//so if you want your app small as possible, Your must use Win32 API entirely.


program TestMessageLoop;

uses
  Sysutils,
  Windows,
  Messages,
  extctrls;

{$R *.RES}

type
  TTest=class
  private
    iCounter:integer;
    Timer:TTimer;
    procedure TimerEvent(Sender:TObject);
  public
    constructor Create;
    destructor  Destroy;override;
  end;

procedure MessageLoop;
var
  Msg: TMsg;
  FTerminate:boolean;
begin
  FTerminate:=False;
  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      if Msg.Message <> WM_QUIT then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end
      else
        FTerminate := True;
    end;
  until FTerminate;
end;

{ TTest }

constructor TTest.Create;
begin
  iCounter:=0;
  Timer:=TTimer.Create(nil);
  Timer.OnTimer:=TimerEvent;
  Timer.Interval:=1000;
  Timer.Enabled:=True;
end;

destructor TTest.Destroy;
begin
  inherited;
  Timer.Enabled:=False;
  Timer.Free;
end;

procedure TTest.TimerEvent(Sender: TObject);
begin
  Inc(iCounter);
  if iCounter>5 then PostThreadMessage(GetCurrentThreadID, WM_QUIT, 0, 0);
  Timer.Enabled:=False;
  MessageBox(0,PChar(IntToStr(iCounter)),'Test',MB_OK);
  Timer.Enabled:=True;
end;

var
  Test:TTest;
begin
  Test:=TTest.Create;
  MessageLoop;
  Test.Free;
end.
0
 
LVL 1

Expert Comment

by:AttarSoftware
ID: 2759596
Have a look at:

http://xcl.cjb.net/

as well, for an alternative to the vcl...

Tim.
0
 

Expert Comment

by:Begli
ID: 2762796
Listening
0
 
LVL 1

Expert Comment

by:xsoft
ID: 2767584
listening
0
 
LVL 4

Expert Comment

by:Radler
ID: 2769018
listening
0
 

Expert Comment

by:Don_Corleone
ID: 2772794
You should try using the Console type application. Of course, if you absolutely must use the components, this won't work.
0
 
LVL 1

Expert Comment

by:xsoft
ID: 2773045
Hi,

this is an example of an app which will reside in the Taskbar Notification area.
This program will start the selected program if you use the left mouse click and can be terminated by a right mouse click.
It will offer two programms to start for every user and a third one only for some special users. (see function CanUseViewer).
The compiled exe is 52 k, the memory usage is ~160 k if the program is not active and about 700 k if its activated.
After performing or aborting an action it will immidiatly be deactivated by the calls:
ShowWindow(Window,SW_MINIMIZE);
ShowWindow(Window,SW_Hide);
You can reduce the size even more if you reduce the code which would be unneccessary for your needs.
The OneExeOnly unit in the uses clause is only to ensure that no second instance of this app can be started.
You can either leave it out or ask me for the code.

HTH,

Thomas
 
program mmquick;

{$R *.RES}// Icons

uses SysUtils,Windows,Messages,ShellAPI,OneExeOnly;

const
  szClassName='MM Quickstarter';// Name der Fensterklasse
  szTitle=szClassName;// Fenstertitel
  cTaskBarId=1;// TaskBar-ID
  PM_TaskBar=WM_User+1;// private Botschaft
  sLFCR=#13#10;
  cm_DokMan=101;
  cm_ProMan=102;
  cm_Viewer=103;
  cm_Quit=201;

var
  aNID:TNotifyIconData;// ShellAPI-Datenstruktur
  aWindow,aMenuL,aMenuR:HWnd;// Fenster-Handle
  AppPath,ProMan,DokMan,Viewer:array[0..2*MAX_PATH+1] of Char;
  Msg,sAppPath,User:string;

function AppStartError(Errorcode:Byte):string;
var
  Msg:string;
begin//Stand 00.00.98
  Msg:='Fehler: '+IntToStr(Errorcode)+#10;
  case Errorcode of
    0:Msg:=Msg+'Zuwenig Speicher, ausführbare Datei war zerstört,'#10
      +'Relokationswerte waren ungültig!';
    2:Msg:=Msg+'Datei wurde nicht gefunden!';
    3:Msg:=Msg+'Verzeichnis wurde nicht gefunden!';
    5:Msg:=Msg+'Fehler beim gemeinsamen Zugriff auf eine Datei,'#10
      +'oder Fehler beim Zugriff auf eine gesperrte Datei im Netz!';
    6:Msg:=Msg+'DLL forderte seperate Datensegmente für jede Task an!';
    8:Msg:=Msg+'Zuwenig Speicher um die Anwendung zu starten!';
    10:Msg:=Msg+'Falsche Windows-Version!';
    11:Msg:=Msg+'Ungültige ausführbare Datei!'#10
      +'(Fehler in Exe-Datei oder keine Windows-Anwendung)';
    12:Msg:=Msg+'Anwendung für ein anderes Betriebssystem!';
    13:Msg:=Msg+'Anwendung für MS-DOS 4.0!';
    14:Msg:=Msg+'Typ der ausführbaren Datei unbekannt!';
    15:Msg:=Msg+'Versuch, eine Real-Mode Anwendung zu laden!';
    19:Msg:=Msg+'Versuch, eine komprimierte ausführbare Datei zu laden!'#10
      +'Die Datei muss dekomprimiert werden, bevor sie geladen werden kann.';
    20:Msg:=Msg+'Ungültige DLL! Eine der DLLs, die benötigt wurde,'#10
      +'um die Anwendung auszuführen, war beschädigt.';
    31:Msg:=Msg+'Diese Datei ist keine ausführbare Datei,'#10
      +'oder sie ist mit keiner Anwendung verknüpft.';
  else
    Msg:=Msg+'Anwendung konnte nicht gestartet werden!';
  end;
  Result:=Msg;
end;

function GetNetName(var NetName:string):Boolean;
var
  USize:Cardinal;lpszUserName:array[0..255] of char;
begin//Stand 00.00.98
  Result:=True;
  NetName:='';
  USize:=SizeOf(lpszUserName);
  if WNetGetUser(nil,(lpszUserName),USize)<>NO_ERROR then begin
    case GetLastError of
      ERROR_NOT_CONNECTED:
        NetName:='Das angegebene Gerät ist kein Netzlaufwerk oder es '
          +'besteht keine Verbindung zum angegebenen Netzwerk.';
      ERROR_MORE_DATA:NetName:='Username zu lang für den Puffer.';
      ERROR_NO_NETWORK:NetName:='Kein Netzwerk vorhanden.';
      ERROR_EXTENDED_ERROR:NetName:='Ein netzwerkspezifischer Fehler ist aufgetreten.';
      ERROR_NO_NET_OR_BAD_PATH:
        NetName:='Das angegebene Netzwerk ist nicht verfügbar. '
          +'(Nicht verbunden oder unbekannter Name)';
    end;
    if NetName='' then NetName:='Unbekannter Fehler bei WNetGetUser';
    Result:=False;
  end
  else
    NetName:=StrPas(lpszUserName);
end;

function CanUseViewer:Boolean;
begin
  Result:=GetNetName(User);
  User:=UpperCase(User);
  if Result then
    Result:=(User='FH')or(User='MS')or(User='TS')or(User='ADMINISTRATOR');
end;

function WindowProc(Window:HWnd;Message:UINT;wParam:WPARAM;LParam:LPARAM):Longint;stdcall;
var P:TPoint;AppWindow:HWnd;Res:integer;Hide:Boolean;
begin
  Result:=0;// Botschaft als bearbeitet markieren
  Hide:=False;
  case Message of
  WM_NULL:Hide:=True;
    WM_COMMAND:begin
        Res:=100;
        case LoWord(wParam) of
          cm_DokMan:begin
              AppWindow:=FindWindow('TFrmDokManMain',nil);
              if AppWindow=0 then
                Res:=shellexecute(aWindow,'open',DokMan,nil,nil,SW_SHOWNORMAL)
              else begin
                AppWIndow:=GetWindowLong(AppWIndow,GWL_HWNDPARENT);
                if IsIconic(AppWIndow) then ShowWindow(AppWindow,SW_RESTORE) else
                  SetForegroundWindow(AppWindow);
              end;
            end;
          cm_ProMan:begin
              AppWindow:=FindWindow('TFrmProManMain',nil);
              if AppWindow=0 then
                Res:=shellexecute(aWindow,'open',ProMan,nil,nil,SW_SHOWNORMAL)
              else begin
                AppWIndow:=GetWindowLong(AppWIndow,GWL_HWNDPARENT);
                if IsIconic(AppWIndow) then ShowWindow(AppWindow,SW_RESTORE) else
                  SetForegroundWindow(AppWindow);
              end;
            end;
          cm_Viewer:begin
              AppWindow:=FindWindow('TFrmMMViewer',nil);
              if AppWindow=0 then
                Res:=shellexecute(aWindow,'open',Viewer,nil,nil,SW_SHOWNORMAL)
              else begin
                AppWIndow:=GetWindowLong(AppWIndow,GWL_HWNDPARENT);
                if IsIconic(AppWIndow) then ShowWindow(AppWindow,SW_RESTORE) else
                  SetForegroundWindow(AppWindow);
              end;
            end;
          cm_Quit:begin
              PostMessage(aWindow,WM_Close,0,0);
              Exit;
            end;
        end;
        if Res<=32 then MessageBox(aWindow,PChar(AppStartError(Res)),
            'MM Quickstarter',MB_ICONINFORMATION or MB_SYSTEMMODAL);
          Hide:=True;
      end;
    PM_TaskBar:begin
        if lParam=WM_LButtonDown then begin// linke Maustaste -> Hauptmenue starten
          aMenuL:=CreatePopUpMenu;
          AppendMenu(aMenuL,MF_ENABLED or MF_STRING,cm_DokMan,'Dokumentenmanager');
          AppendMenu(aMenuL,MF_ENABLED or MF_STRING,cm_ProMan,'Projektmanager');
          if CanUseViewer then
            AppendMenu(aMenuL,MF_ENABLED or MF_STRING,cm_Viewer,'MM-Viewer');
          GetCursorPos(P);
          SetForegroundWindow(aWindow);
          TrackPopupMenu(aMenuL,TPM_LEFTALIGN or TPM_LEFTBUTTON,p.x,p.y,0,aWindow,nil);
          PostMessage(aWindow,WM_NULL,0,0);
          DestroyMenu(aMenuL);
          Hide:=True;
        end;
        if lParam=WM_RButtonDown then begin// rechte Maustaste -> Beenden-Menue starten
          aMenuR:=CreatePopUpMenu;
          AppendMenu(aMenuR,MF_ENABLED or MF_STRING,cm_Quit,'MM Quickstarter beenden');
          GetCursorPos(P);
          SetForegroundWindow(aWindow);
          TrackPopupMenu(aMenuR,TPM_LEFTALIGN or TPM_LEFTBUTTON,p.x,p.y,0,aWindow,nil);
          PostMessage(aWindow,WM_NULL,0,0);
          DestroyMenu(aMenuR);
          Hide:=True;
        end;
      end;
    WM_Destroy:begin// Icon im Benachrichtungsbereich abmelden
        aNID.cbSize:=SizeOf(TNotifyIconData);
        aNID.Wnd:=aWindow;
        aNID.uID:=cTaskBarId;
        Shell_NotifyIcon(NIM_DELETE,@aNID);
        DestroyMenu(aMenuL);
        DestroyMenu(aMenuR);
        PostQuitMessage(0);// Programm beenden
        Exit;
      end;
  end;
  if Hide then begin//Fenster verkleinern und verstecken
    ShowWindow(Window,SW_MINIMIZE);
    ShowWindow(Window,SW_Hide);
  end;
  Result:=DefWindowProc(Window,Message,WParam,LParam);
end;

procedure WinMain;
var
  WindowClass:TWndClassEx;
  Message:TMsg;
begin// InitApplication
  WindowClass.cbSize:=SizeOf(TWndClassEx);
  WindowClass.Style:=CS_HRedraw or CS_VRedraw;
  WindowClass.hInstance:=HInstance;
  WindowClass.lpfnWndProc:=@WindowProc;
  WindowClass.cbClsExtra:=0;
  WindowClass.cbWndExtra:=0;
  WindowClass.hIcon:=0;
  WindowClass.hIconSm:=0;
  WindowClass.hCursor:=LoadCursor(0,idc_Arrow);
  WindowClass.hbrBackground:=COLOR_WINDOW+1;
  WindowClass.lpszMenuName:=nil;
  WindowClass.lpszClassName:=szClassName;
  if RegisterClassEx(WindowClass)=0 then Halt(1);// Rückgabewert 0 -> Fehlschlag
  // InitInstance
  aWindow:=CreateWindow(szClassName,szTitle,WS_OverlappedWindow,0,0,0,0,0,0,HInstance,nil);
  if aWindow=0 then Halt(2);// aWindow = 0 -> Fehlschlag
//  Fensterhandle ist gültig->Benachrichtungsbereich aktivieren
  aNID.cbSize:=SizeOf(TNotifyIconData);
  aNID.Wnd:=aWindow;
  aNID.uID:=cTaskBarId;
  aNID.uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
  aNID.uCallBackMessage:=PM_TaskBar;
  aNID.hIcon:=LoadImage(hInstance,PChar('SMALL'),IMAGE_ICON,16,16,0);
  aNID.szTip:='Media Mirror Quickstarter';
  Shell_NotifyIcon(NIM_ADD,@aNID);
  PostMessage(aWindow,WM_NULL,0,0);
  while GetMessage(Message,0,0,0) do begin// Message-Loop wartet auf das Programmende
    TranslateMessage(Message);
    DispatchMessage(Message);
  end;
  Halt(Message.wParam);
end;

begin
  GetModuleFileName(0,(AppPath),SizeOf(AppPath));
  sAppPath:=AppPath;
  sAppPath:=ExtractFilePath(sAppPath);
  if sAppPath[Length(sAppPath)]<>'\' then sAppPath:=sAppPath+'\';
  sAppPath:=sAppPath+'MMQuick.ini';
  if GetPrivateProfileString('Apps','DokMan','',DokMan,MAX_PATH,PChar(sAppPath))=0 then
    MessageBox(aWindow,'Tragen Sie den Dokumentenmanager-Pfad in die Konfigurationsdatei'#10
      +'in der Sektion "Apps" unter dem Schlüssel "DokMan=" ein.',
      'MM Quickstarter',MB_ICONINFORMATION or MB_SYSTEMMODAL);
  if GetPrivateProfileString('Apps','ProMan','',ProMan,MAX_PATH,PCHar(sAppPath))=0 then
    MessageBox(aWindow,'Tragen Sie den Projektmanager-Pfad in die Konfigurationsdatei'#10
      +'in der Sektion "Apps" unter dem Schlüssel "ProMan=" ein.',
      'MM Quickstarter',MB_ICONINFORMATION or MB_SYSTEMMODAL);
  if CanUseViewer then
    if GetPrivateProfileString('Apps','Viewer','',Viewer,MAX_PATH,PCHar(sAppPath))=0 then
      MessageBox(aWindow,'Tragen Sie den MM-Viewer-Pfad in die Konfigurationsdatei'#10
        +'in der Sektion "Apps" unter dem Schlüssel "Viewer=" ein.',
        'MM Viewer',MB_ICONINFORMATION or MB_SYSTEMMODAL);
  Msg:='AppPath:'+#10+AppPath+#10+'DokMan:'+#10+DokMan+#10+'ProMan:'+#10+ProMan;
  if ParamCount>0 then
    MessageBox(aWindow,PChar(Msg),'MM Quickstarter',MB_ICONINFORMATION or MB_SYSTEMMODAL);
  WinMain;//Hauptprogramm
end.

0
 

Expert Comment

by:we11er
ID: 2896726
Listening...
0
 

Author Comment

by:ILPowerSoft
ID: 2896852
shenqw is answerd the Q
0
 

Author Comment

by:ILPowerSoft
ID: 2896855
Comment accepted as answer
0
 

Author Comment

by:ILPowerSoft
ID: 2896856
good job sorry you waited so long
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses

704 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question