Solved

App without FORM.

Posted on 2000-04-26
15
233 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
  • 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
 

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 100 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
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Suggested Solutions

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now