home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / MONFORM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  9KB  |  327 lines

  1. unit MonForm;
  2.  
  3. { Interprocess Communication Demo
  4.  
  5.   This program along with the Client.dpr project, demonstrate a number
  6.   of topics in Win32 programming. Threads, Events, Mutexes, and Shared
  7.   memory are all used to provide communication between this monitor and
  8.   it's clients, see IPCThrd.pas.
  9.  
  10.   To Run, compile this project and the Client.dpr project.  Run one
  11.   instance of the monitor and then run several instances of the client.
  12.   You can switch between clients by clicking on the Client's window or
  13.   by selecting it from the Client menu in the monitor.
  14.  
  15.   Topics Covered:
  16.   
  17.     Interprocess Communication
  18.     Threads
  19.     Events
  20.     Mutexes
  21.     Shared Memory
  22.     Single instance EXE.
  23.  
  24. }
  25.  
  26. interface
  27.  
  28. uses
  29.   SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  30.   StdCtrls, Typinfo, IPCThrd, Buttons, ComCtrls, ExtCtrls, Menus;
  31.  
  32. const
  33.   WM_SETTRACEDATA = WM_USER + 1;
  34.   WM_UPDATESTATUS = WM_USER + 2;
  35.   WM_UPDATEMENU   = WM_USER + 3;
  36.  
  37. type
  38.   TWMTraceData = record
  39.     Msg: Cardinal;
  40.     X: Smallint;
  41.     Y: Smallint;
  42.     Flag: TClientFlag;
  43.     Result: Longint;
  44.   end;
  45.  
  46.   TLabelRec = record
  47.     XLabel: TLabel;
  48.     YLabel: TLabel;
  49.   end;
  50.  
  51.   TMonitorForm = class(TForm)
  52.     DownX: TLabel;
  53.     DownY: TLabel;
  54.     SizeX: TLabel;
  55.     SizeY: TLabel;
  56.     MoveX: TLabel;
  57.     MoveY: TLabel;
  58.     Bevel1: TBevel;
  59.     Panel1: TPanel;
  60.     PauseButton: TSpeedButton;
  61.     StatusBar: TStatusBar;
  62.     MouseMove: TCheckBox;
  63.     MouseDown: TCheckBox;
  64.     WindowSize: TCheckBox;
  65.     MainMenu: TMainMenu;
  66.     Options1: TMenuItem;
  67.     AutoClientSwitch1: TMenuItem;
  68.     PlaceHolder21: TMenuItem;
  69.     File1: TMenuItem;
  70.     miFileExit: TMenuItem;
  71.     miClients: TMenuItem;
  72.     PlaceHolder1: TMenuItem;
  73.     Help1: TMenuItem;
  74.     About1: TMenuItem;
  75.     ShowTraceButton: TSpeedButton;
  76.     ClearButton: TSpeedButton;
  77.     ExitButton: TSpeedButton;
  78.     procedure FormCreate(Sender: TObject);
  79.     procedure FormDestroy(Sender: TObject);
  80.     procedure ClientMenuClick(Sender: TObject);
  81.     procedure miClientsClick(Sender: TObject);
  82.     procedure SetTraceFlags(Sender: TObject);
  83.     procedure AutoClientSwitch1Click(Sender: TObject);
  84.     procedure miFileExitClick(Sender: TObject);
  85.     procedure ShowTraceButtonClick(Sender: TObject);
  86.     procedure PauseButtonClick(Sender: TObject);
  87.     procedure ClearButtonClick(Sender: TObject);
  88.     procedure ExitButtonClick(Sender: TObject);
  89.     procedure About1Click(Sender: TObject);
  90.   private
  91.     FTraceMsg: TWMTraceData;
  92.     IPCMonitor: TIPCMonitor;
  93.     TraceLabels: array[TClientFlag] of TLabelRec;
  94.     FClientData: TEventData;
  95.     FStatusText: string;
  96.     procedure ClearLabels;
  97.     procedure OnConnect(Sender: TIPCThread; Connecting: Boolean);
  98.     procedure OnDirectoryUpdate(Sender: TIPCThread);
  99.     procedure OnSignal(Sender: TIPCThread; Data: TEventData);
  100.     procedure SignalClientStatus;
  101.     procedure UpdateTraceData(var Msg: TWMTraceData); message WM_SETTRACEDATA;
  102.     procedure UpdateStatusBar(var Msg: TMessage); message WM_UPDATESTATUS;
  103.     procedure UpdateClientMenu(var Msg: TMessage); message WM_UPDATEMENU;
  104.   end;
  105.  
  106.  
  107. var
  108.   MonitorForm: TMonitorForm;
  109.  
  110. implementation
  111.  
  112. uses TrcView, About;
  113.  
  114. {$R *.DFM}
  115.  
  116. { Private Routines }
  117.  
  118. procedure TMonitorForm.ClearLabels;
  119. var
  120.   Index: TClientFlag;
  121. begin
  122.   for Index := Low(TClientFlag) to High(TClientFlag) do
  123.   begin
  124.     TraceLabels[Index].YLabel.Caption := '0';
  125.     TraceLabels[Index].XLabel.Caption := '0';
  126.   end;
  127. end;
  128.  
  129. procedure TMonitorForm.OnConnect(Sender: TIPCThread; Connecting: Boolean);
  130. begin
  131.   if Connecting then
  132.   begin
  133.     FStatusText := IPCMonitor.ClientName;
  134.     SignalClientStatus;
  135.   end
  136.   else
  137.     FStatusText := 'No Client';
  138.   PostMessage(Handle, WM_UPDATESTATUS, 0, 0);
  139. end;
  140.  
  141. { When a client starts or stops we need to update the client menu.
  142.   We do this by posting a message to the Monitor Form, which in turn causes
  143.   the UpdateClientMenu method to be invoked.  We use this approach, rather than
  144.   calling UpdateClientMenu directly because this code is not being executed
  145.   by the main thread, but rather by the thread used in the TMonitorThread
  146.   class.  We could also have used the TThread.Synchonize method, but since
  147.   there is no need for the IPC thread to wait for the monitor to update
  148.   the menu, this approach is more effecient. }
  149.  
  150. procedure TMonitorForm.OnDirectoryUpdate(Sender: TIPCThread);
  151. begin
  152.   PostMessage(Handle, WM_UPDATEMENU, 0, 0);
  153. end;
  154.  
  155. { This event is triggered when the client has new data for us.  As with
  156.   the OnDirectoryUpdate event above, we use PostMessage to get the main
  157.   thread to update the display. }
  158.  
  159. procedure TMonitorForm.OnSignal(Sender: TIPCThread; Data: TEventData);
  160. begin
  161.   FTraceMsg.X := Data.X;
  162.   FTraceMsg.Y := Data.Y;
  163.   FTraceMsg.Flag := Data.Flag;
  164.   PostMessage(Handle, WM_SETTRACEDATA, TMessage(FTraceMsg).WPARAM,
  165.     TMessage(FTraceMsg).LPARAM);
  166. end;
  167.  
  168. procedure TMonitorForm.SignalClientStatus;
  169. begin
  170.   if PauseButton.Down then
  171.     IPCMonitor.SignalClient([]) else
  172.     IPCMonitor.SignalClient(FClientData.Flags);
  173. end;
  174.  
  175. procedure TMonitorForm.UpdateTraceData(var Msg: TWMTraceData);
  176. begin
  177.   with Msg do
  178.     if Flag in FClientData.Flags then
  179.     begin
  180.       TraceLabels[Flag].XLabel.Caption := IntToStr(X);
  181.       TraceLabels[Flag].YLabel.Caption := IntToStr(Y);
  182.     end
  183. end;
  184.  
  185. procedure TMonitorForm.UpdateStatusBar(var Msg: TMessage);
  186. begin
  187.   StatusBar.SimpleText := FStatusText;
  188.   ClearLabels;
  189. end;
  190.  
  191. procedure TMonitorForm.UpdateClientMenu(var Msg: TMessage);
  192. var
  193.   I, ID: Integer;
  194.   List: TStringList;
  195.   mi: TMenuItem;
  196. begin
  197.   List := TStringList.Create;
  198.   try
  199.     IPCMonitor.GetClientNames(List);
  200.     while miClients.Count > 0 do miClients.Delete(0);
  201.     if List.Count < 1 then
  202.       miClients.Add(NewItem('(None)', 0, False, False, nil, 0, ''))
  203.     else
  204.       for I := 0 to List.Count - 1 do
  205.       begin
  206.         ID := Integer(List.Objects[I]);
  207.         mi := NewItem(List[I], 0, False, True, ClientMenuClick, 0, '');
  208.         mi.Tag := ID;
  209.         mi.RadioItem := True;
  210.         mi.GroupIndex := 1;
  211.         miClients.Add(MI);
  212.       end;
  213.   finally
  214.     List.Free;
  215.   end;
  216. end;
  217.  
  218. { Event Handlers }
  219.  
  220. procedure TMonitorForm.FormCreate(Sender: TObject);
  221.  
  222.   procedure SetupLabelArray;
  223.   begin
  224.     TraceLabels[cfMouseMove].XLabel := MoveX;
  225.     TraceLabels[cfMouseMove].YLabel := MoveY;
  226.     TraceLabels[cfMouseDown].XLabel := DownX;
  227.     TraceLabels[cfMouseDown].YLabel := DownY;
  228.     TraceLabels[cfResize].XLabel := SizeX;
  229.     TraceLabels[cfResize].YLabel := SizeY;
  230.   end;
  231.  
  232. begin
  233.   IPCMonitor := TIPCMonitor.Create(Application.Handle, 'Monitor');
  234.   IPCMonitor.OnSignal := OnSignal;
  235.   IPCMonitor.OnConnect := OnConnect;
  236.   IPCMonitor.OnDirectoryUpdate := OnDirectoryUpdate;
  237.   IPCMonitor.Activate;
  238.   OnDirectoryUpdate(nil);
  239.   OnConnect(nil, False);
  240.   FClientData.Flags := [cfMouseMove, cfMouseDown, cfReSize];
  241.   SetupLabelArray;
  242. end;
  243.  
  244. procedure TMonitorForm.FormDestroy(Sender: TObject);
  245. begin
  246.   IPCMonitor.Free;
  247. end;
  248.  
  249. procedure TMonitorForm.ClientMenuClick(Sender: TObject);
  250. var
  251.   NewID: Integer;
  252. begin
  253.   NewID := (Sender as TMenuItem).Tag;
  254.   if NewID <> IPCMonitor.ClientID then
  255.     IPCMonitor.ClientID := NewID;
  256. end;
  257.  
  258. procedure TMonitorForm.miClientsClick(Sender: TObject);
  259. var
  260.   I: Integer;
  261. begin
  262.   if IPCMonitor.ClientID <> 0 then
  263.     for I := 0 to miClients.Count - 1 do
  264.       with miClients.Items[I] do
  265.         if Tag = IPCMonitor.ClientID then
  266.         begin
  267.           Checked := True;
  268.           System.Break;
  269.         end;
  270. end;
  271.  
  272. procedure TMonitorForm.SetTraceFlags(Sender: TObject);
  273. var
  274.   F: TClientFlag;
  275. begin
  276.   with (Sender as TCheckBox) do
  277.   begin
  278.     F := TClientFlag(Tag);
  279.     if Checked then
  280.       Include(FClientData.Flags, F) else
  281.       Exclude(FClientData.Flags, F);
  282.   end;
  283.   SignalClientStatus;
  284. end;
  285.  
  286. procedure TMonitorForm.AutoClientSwitch1Click(Sender: TObject);
  287. begin
  288.   with (Sender as TMenuItem) do
  289.   begin
  290.     Checked := not Checked;
  291.     IPCMonitor.AutoSwitch := Checked;
  292.   end;
  293. end;
  294.  
  295. procedure TMonitorForm.miFileExitClick(Sender: TObject);
  296. begin
  297.   Close;
  298. end;
  299.  
  300. procedure TMonitorForm.ShowTraceButtonClick(Sender: TObject);
  301. begin
  302.   IPCMonitor.GetDebugInfo(TraceForm.TraceData.Items);
  303.   TraceForm.ShowModal;
  304. end;
  305.  
  306. procedure TMonitorForm.PauseButtonClick(Sender: TObject);
  307. begin
  308.   SignalClientStatus;
  309. end;
  310.  
  311. procedure TMonitorForm.ClearButtonClick(Sender: TObject);
  312. begin
  313.   IPCMonitor.ClearDebugInfo;
  314. end;
  315.  
  316. procedure TMonitorForm.ExitButtonClick(Sender: TObject);
  317. begin
  318.   Close;
  319. end;
  320.  
  321. procedure TMonitorForm.About1Click(Sender: TObject);
  322. begin
  323.   ShowAboutBox;
  324. end;
  325.  
  326. end.
  327.