Marco Web Center |
Home: Code Repository: Mastering Delphi 5Project MSGFLOW
Project StructureMSGFLOW.DPRprogram Msgflow; uses Forms, FlowF in 'FlowF.pas' {Form1}, Mlist in 'MLIST.PAS', Unit2 in 'UNIT2.PAS' {Form2}; {$R *.RES} begin Application.CreateForm(TForm1, Form1); Application.Run; end. FLOWF.PASunit FlowF; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls; type TForm1 = class(TForm) ListBox1: TListBox; Panel1: TPanel; SpyButton: TSpeedButton; SkipButton: TSpeedButton; ClearButton: TSpeedButton; ShowButton: TSpeedButton; procedure FormCreate(Sender: TObject); procedure SpyButtonClick(Sender: TObject); procedure SkipButtonClick(Sender: TObject); procedure ClearButtonClick(Sender: TObject); procedure ShowButtonClick(Sender: TObject); private Skipping, Spying: Boolean; LastMessage: TMsg; public procedure HandleMessage (var Msg: TMsg; var Handled: Boolean); end; var Form1: TForm1; implementation {$R *.DFM} uses Mlist, {define the string list of messages} Unit2; {define the secondary form, TForm2} procedure TForm1.FormCreate(Sender: TObject); begin {set the OnMessage handler} Application.OnMessage := HandleMessage; Skipping := False; Spying := False; end; procedure TForm1.HandleMessage (var Msg: TMsg; var Handled: Boolean); var Line, Caption: string; begin // initialize long strings SetLength (Line, 200); SetLength (Caption, 50); {output the new message only if the spying flag is true, the message is not for the list box. If the skipping flag is true, ignore a message equal to the previous one} if Spying and (Msg.Hwnd <> Listbox1.Handle) and not (Skipping and (LastMessage.Message = Msg.Message) and (LastMessage.Hwnd = Msg.Hwnd)) then begin // output the hex value of the handle Line := 'Hwnd:' + IntToHex (Msg.Hwnd, 4); {get the caption from the handle, using an API function} GetWindowText (Msg.Hwnd, PChar (Caption), Length (Caption)); Caption := PChar (Caption); // re-cast if Caption = '' then Caption := 'Unknown'; // format the caption in 15 characters AppendStr (Line, Format (' ( %15s ) ', [Caption])); {access the MsgList object, using the function exported by the MList unit} AppendStr (Line, GetMessageName (Msg.Message)); {add the hexadecimal output of the two message parameters} AppendStr (Line, 'Params: ' + IntToHex (Msg.wParam, 8) + ', ' + IntToHex (Msg.lParam, 8)); {add the line, selecting it} ListBox1.ItemIndex := ListBox1.Items.Add (Line); {store the message, to compare it with the next one} LastMessage := Msg; end; end; procedure TForm1.SpyButtonClick(Sender: TObject); begin Spying := SpyButton.Down; end; procedure TForm1.SkipButtonClick(Sender: TObject); begin Skipping := SkipButton.Down; end; procedure TForm1.ClearButtonClick(Sender: TObject); begin ListBox1.Clear; end; procedure TForm1.ShowButtonClick(Sender: TObject); var SecondForm: TForm2; begin {create and show the second form} SecondForm := TForm2.Create (Application); SecondForm.Show; end; end. MLIST.PASunit Mlist; interface uses SysUtils, Classes, Messages; var MsgList: TStringList; function GetMessageName (Msg: Integer): string; implementation function GetMessageName (Msg: Integer): string; var N: Integer; begin N := MsgList.IndexOfObject (TObject(Msg)); if N >= 0 then Result := MsgList.Strings [N] else if Msg >= wm_User then Result := 'wm_User message ' else Result := 'Unknown message '; end; initialization MsgList := TStringList.Create; MsgList.AddObject ('wm_Null ', TObject($0000)); MsgList.AddObject ('wm_Create ', TObject($0001)); MsgList.AddObject ('wm_Destroy ', TObject($0002)); MsgList.AddObject ('wm_Move ', TObject($0003)); MsgList.AddObject ('wm_Size ', TObject($0005)); MsgList.AddObject ('wm_Activate ', TObject($0006)); MsgList.AddObject ('wm_SetFocus ', TObject($0007)); MsgList.AddObject ('wm_KillFocus ', TObject($0008)); MsgList.AddObject ('wm_Enable ', TObject($000A)); MsgList.AddObject ('wm_SetRedraw ', TObject($000B)); MsgList.AddObject ('wm_SetText ', TObject($000C)); MsgList.AddObject ('wm_GetText ', TObject($000D)); MsgList.AddObject ('wm_GetTextLength ', TObject($000E)); MsgList.AddObject ('wm_Paint ', TObject($000F)); MsgList.AddObject ('wm_Close ', TObject($0010)); MsgList.AddObject ('wm_QueryEndSession ', TObject($0011)); MsgList.AddObject ('wm_Quit ', TObject($0012)); MsgList.AddObject ('wm_QueryOpen ', TObject($0013)); MsgList.AddObject ('wm_EraseBkGnd ', TObject($0014)); MsgList.AddObject ('wm_SysColorChange ', TObject($0015)); MsgList.AddObject ('wm_EndSession ', TObject($0016)); MsgList.AddObject ('wm_SystemError ', TObject($0017)); MsgList.AddObject ('wm_ShowWindow ', TObject($0018)); MsgList.AddObject ('wm_CtlColor ', TObject($0019)); MsgList.AddObject ('wm_WinIniChange ', TObject($001A)); MsgList.AddObject ('wm_DevModeChange ', TObject($001B)); MsgList.AddObject ('wm_ActivateApp ', TObject($001C)); MsgList.AddObject ('wm_FontChange ', TObject($001D)); MsgList.AddObject ('wm_TimeChange ', TObject($001E)); MsgList.AddObject ('wm_CancelMode ', TObject($001F)); MsgList.AddObject ('wm_SetCursor ', TObject($0020)); MsgList.AddObject ('wm_MouseActivate ', TObject($0021)); MsgList.AddObject ('wm_ChildActivate ', TObject($0022)); MsgList.AddObject ('wm_QueueSync ', TObject($0023)); MsgList.AddObject ('wm_GetMinMaxInfo ', TObject($0024)); MsgList.AddObject ('wm_PaintIcon ', TObject($0026)); MsgList.AddObject ('wm_IconEraseBkGnd ', TObject($0027)); MsgList.AddObject ('wm_NextDlgCtl ', TObject($0028)); MsgList.AddObject ('wm_SpoolerStatus ', TObject($002A)); MsgList.AddObject ('wm_DrawItem ', TObject($002B)); MsgList.AddObject ('wm_MeasureItem ', TObject($002C)); MsgList.AddObject ('wm_DeleteItem ', TObject($002D)); MsgList.AddObject ('wm_VKeyToItem ', TObject($002E)); MsgList.AddObject ('wm_CharToItem ', TObject($002F)); MsgList.AddObject ('wm_SetFont ', TObject($0030)); MsgList.AddObject ('wm_GetFont ', TObject($0031)); MsgList.AddObject ('wm_QueryDragIcon ', TObject($0037)); MsgList.AddObject ('wm_CompareItem ', TObject($0039)); MsgList.AddObject ('wm_Compacting ', TObject($0041)); MsgList.AddObject ('wm_CommNotify ', TObject($0044)); MsgList.AddObject ('wm_WindowPosChanging', TObject($0046)); MsgList.AddObject ('wm_WindowPosChanged ', TObject($0047)); MsgList.AddObject ('wm_Power ', TObject($0048)); MsgList.AddObject ('wm_CopyData ', TObject($004A)); MsgList.AddObject ('wm_CancelJournal ', TObject($004B)); MsgList.AddObject ('wm_Notify ', TObject($004E)); MsgList.AddObject ('wm_StyleChanging ', TObject($007C)); MsgList.AddObject ('wm_StyleChanged ', TObject($007D)); MsgList.AddObject ('wm_GetIcon ', TObject($007F)); MsgList.AddObject ('wm_SetIcon ', TObject($0080)); MsgList.AddObject ('wm_NCCreate ', TObject($0081)); MsgList.AddObject ('wm_NCDestroy ', TObject($0082)); MsgList.AddObject ('wm_NCCalcSize ', TObject($0083)); MsgList.AddObject ('wm_NCHitTest ', TObject($0084)); MsgList.AddObject ('wm_NCPaint ', TObject($0085)); MsgList.AddObject ('wm_NCActivate ', TObject($0086)); MsgList.AddObject ('wm_GetDlgCode ', TObject($0087)); MsgList.AddObject ('wm_NCMouseMove ', TObject($00A0)); MsgList.AddObject ('wm_NCLButtonDown ', TObject($00A1)); MsgList.AddObject ('wm_NCLButtonUp ', TObject($00A2)); MsgList.AddObject ('wm_NCLButtonDblClk ', TObject($00A3)); MsgList.AddObject ('wm_NCRButtonDown ', TObject($00A4)); MsgList.AddObject ('wm_NCRButtonUp ', TObject($00A5)); MsgList.AddObject ('wm_NCRButtonDblClk ', TObject($00A6)); MsgList.AddObject ('wm_NCMButtonDown ', TObject($00A7)); MsgList.AddObject ('wm_NCMButtonUp ', TObject($00A8)); MsgList.AddObject ('wm_NCMButtonDblClk ', TObject($00A9)); MsgList.AddObject ('wm_KeyDown ', TObject($0100)); MsgList.AddObject ('wm_KeyUp ', TObject($0101)); MsgList.AddObject ('wm_Char ', TObject($0102)); MsgList.AddObject ('wm_DeadChar ', TObject($0103)); MsgList.AddObject ('wm_SysKeyDown ', TObject($0104)); MsgList.AddObject ('wm_SysKeyUp ', TObject($0105)); MsgList.AddObject ('wm_SysChar ', TObject($0106)); MsgList.AddObject ('wm_SysDeadChar ', TObject($0107)); MsgList.AddObject ('wm_InitDialog ', TObject($0110)); MsgList.AddObject ('wm_Command ', TObject($0111)); MsgList.AddObject ('wm_SysCommand ', TObject($0112)); MsgList.AddObject ('wm_Timer ', TObject($0113)); MsgList.AddObject ('wm_HScroll ', TObject($0114)); MsgList.AddObject ('wm_VScroll ', TObject($0115)); MsgList.AddObject ('wm_InitMenu ', TObject($0116)); MsgList.AddObject ('wm_InitMenuPopup ', TObject($0117)); MsgList.AddObject ('wm_MenuSelect ', TObject($011F)); MsgList.AddObject ('wm_MenuChar ', TObject($0120)); MsgList.AddObject ('wm_EnterIdle ', TObject($0121)); MsgList.AddObject ('wm_CtlColorMsgbox ', TObject($0132)); MsgList.AddObject ('wm_CtlColorEdit ', TObject($0133)); MsgList.AddObject ('wm_CtlColorListbox ', TObject($0134)); MsgList.AddObject ('wm_CtlColorBtn ', TObject($0135)); MsgList.AddObject ('wm_CtlColorDlg ', TObject($0136)); MsgList.AddObject ('wm_CtlColorScrollbar', TObject($0137)); MsgList.AddObject ('wm_CtlColorStatic ', TObject($0138)); MsgList.AddObject ('wm_MouseMove ', TObject($0200)); MsgList.AddObject ('wm_LButtonDown ', TObject($0201)); MsgList.AddObject ('wm_LButtonUp ', TObject($0202)); MsgList.AddObject ('wm_LButtonDblClk ', TObject($0203)); MsgList.AddObject ('wm_RButtonDown ', TObject($0204)); MsgList.AddObject ('wm_RButtonUp ', TObject($0205)); MsgList.AddObject ('wm_RButtonDblClk ', TObject($0206)); MsgList.AddObject ('wm_MButtonDown ', TObject($0207)); MsgList.AddObject ('wm_MButtonUp ', TObject($0208)); MsgList.AddObject ('wm_MButtonDblClk ', TObject($0209)); MsgList.AddObject ('wm_ParentNotify ', TObject($0210)); MsgList.AddObject ('wm_MDICreate ', TObject($0220)); MsgList.AddObject ('wm_MDIDestroy ', TObject($0221)); MsgList.AddObject ('wm_MDIActivate ', TObject($0222)); MsgList.AddObject ('wm_MDIRestore ', TObject($0223)); MsgList.AddObject ('wm_MDINext ', TObject($0224)); MsgList.AddObject ('wm_MDIMaximize ', TObject($0225)); MsgList.AddObject ('wm_MDITile ', TObject($0226)); MsgList.AddObject ('wm_MDICascade ', TObject($0227)); MsgList.AddObject ('wm_MDIIconArrange ', TObject($0228)); MsgList.AddObject ('wm_MDIGetActive ', TObject($0229)); MsgList.AddObject ('wm_MDISetMenu ', TObject($0230)); MsgList.AddObject ('wm_DropFiles ', TObject($0233)); MsgList.AddObject ('wm_MDIRefreshMenu ', TObject($0234)); MsgList.AddObject ('wm_Cut ', TObject($0300)); MsgList.AddObject ('wm_Copy ', TObject($0301)); MsgList.AddObject ('wm_Paste ', TObject($0302)); MsgList.AddObject ('wm_Clear ', TObject($0303)); MsgList.AddObject ('wm_Undo ', TObject($0304)); MsgList.AddObject ('wm_RenderFormat ', TObject($0305)); MsgList.AddObject ('wm_RenderAllFormats ', TObject($0306)); MsgList.AddObject ('wm_DestroyClipboard ', TObject($0307)); MsgList.AddObject ('wm_DrawClipboard ', TObject($0308)); MsgList.AddObject ('wm_PaintClipboard ', TObject($0309)); MsgList.AddObject ('wm_VScrollClipboard ', TObject($030A)); MsgList.AddObject ('wm_SizeClipboard ', TObject($030B)); MsgList.AddObject ('wm_AskCBFormatName ', TObject($030C)); MsgList.AddObject ('wm_ChangeCBChain ', TObject($030D)); MsgList.AddObject ('wm_HScrollClipboard ', TObject($030E)); MsgList.AddObject ('wm_QueryNewPalette ', TObject($030F)); MsgList.AddObject ('wm_PaletteIsChanging', TObject($0310)); MsgList.AddObject ('wm_PaletteChanged ', TObject($0311)); end. UNIT2.PASunit Unit2; interface uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus; type TForm2 = class(TForm) Edit1: TEdit; Button1: TButton; Button2: TButton; RadioButton1: TRadioButton; RadioButton2: TRadioButton; ComboBox1: TComboBox; MainMenu1: TMainMenu; File1: TMenuItem; Exit1: TMenuItem; N1: TMenuItem; PrintSetup1: TMenuItem; Print1: TMenuItem; N2: TMenuItem; SaveAs1: TMenuItem; Save1: TMenuItem; Open1: TMenuItem; New1: TMenuItem; Edit2: TMenuItem; Object1: TMenuItem; Links1: TMenuItem; N3: TMenuItem; GoTo1: TMenuItem; Replace1: TMenuItem; Find1: TMenuItem; N4: TMenuItem; PasteSpecial1: TMenuItem; Paste1: TMenuItem; Copy1: TMenuItem; Cut1: TMenuItem; N5: TMenuItem; Repeatcommand1: TMenuItem; Undo1: TMenuItem; Help1: TMenuItem; About1: TMenuItem; HowtoUseHelp1: TMenuItem; Tutorial1: TMenuItem; SearchforHelpOn1: TMenuItem; Keyboard1: TMenuItem; Procedures1: TMenuItem; Commands1: TMenuItem; Index1: TMenuItem; Contents1: TMenuItem; PopupMenu1: TPopupMenu; About2: TMenuItem; HowtoUseHelp2: TMenuItem; Tutorial2: TMenuItem; SearchforHelpOn2: TMenuItem; Keyboard2: TMenuItem; Procedures2: TMenuItem; Commands2: TMenuItem; Index2: TMenuItem; Contents2: TMenuItem; ListBox1: TListBox; procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public { Public declarations } end; {var Form2: TForm2;} implementation {$R *.DFM} procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); begin Action := caFree; end; end. FLOWF.DFMobject Form1: TForm1 Left = 118 Top = 107 Width = 600 Height = 450 Caption = 'Message Flow' Font.Color = clWindowText Font.Height = -13 Font.Name = 'System' Font.Style = [] OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 16 object ListBox1: TListBox Left = 0 Top = 41 Width = 592 Height = 382 Align = alClient Font.Color = clBlack Font.Height = -12 Font.Name = 'Courier New' Font.Style = [fsBold] ItemHeight = 16 ParentFont = False TabOrder = 0 end object Panel1: TPanel Left = 0 Top = 0 Width = 592 Height = 41 Align = alTop Alignment = taRightJustify Caption = 'Panel1' Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] ParentFont = False TabOrder = 1 object SpyButton: TSpeedButton Left = 16 Top = 8 Width = 81 Height = 25 AllowAllUp = True GroupIndex = 1 Caption = 'Spy On' OnClick = SpyButtonClick end object SkipButton: TSpeedButton Left = 136 Top = 8 Width = 81 Height = 25 AllowAllUp = True GroupIndex = 2 Caption = 'Skip 2nd' OnClick = SkipButtonClick end object ClearButton: TSpeedButton Left = 248 Top = 8 Width = 81 Height = 25 Caption = 'Clear' OnClick = ClearButtonClick end object ShowButton: TSpeedButton Left = 360 Top = 8 Width = 81 Height = 25 Caption = 'Show' OnClick = ShowButtonClick end end end UNIT2.DFMobject Form2: TForm2 Left = 204 Top = 200 Width = 385 Height = 239 Caption = 'Sample form' Font.Color = clBlack Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] Menu = MainMenu1 PixelsPerInch = 96 OnClose = FormClose TextHeight = 13 object Edit1: TEdit Left = 16 Top = 8 Width = 161 Height = 21 TabOrder = 0 Text = 'Edit1' end object Button1: TButton Left = 200 Top = 8 Width = 81 Height = 25 Caption = 'Button1' TabOrder = 1 end object Button2: TButton Left = 288 Top = 8 Width = 81 Height = 25 Caption = 'Button2' TabOrder = 2 end object RadioButton1: TRadioButton Left = 16 Top = 56 Width = 113 Height = 17 Caption = 'RadioButton1' TabOrder = 3 end object RadioButton2: TRadioButton Left = 16 Top = 80 Width = 113 Height = 17 Caption = 'RadioButton2' TabOrder = 4 end object ComboBox1: TComboBox Left = 16 Top = 120 Width = 161 Height = 21 ItemHeight = 13 Items.Strings = ( 'One' 'Two' 'Three' 'Four' 'Five' 'Six ' 'Seven' 'Eight' 'Nine' 'Ten') TabOrder = 5 Text = 'ComboBox1' end object ListBox1: TListBox Left = 200 Top = 48 Width = 169 Height = 137 ItemHeight = 13 Items.Strings = ( 'One' 'Two' 'Three' 'Four' 'Five' 'Six ' 'Seven' 'Eight' 'Nine' 'Ten') TabOrder = 6 end object MainMenu1: TMainMenu Left = 32 Top = 144 object File1: TMenuItem Caption = '&File' object New1: TMenuItem Caption = '&New' end object Open1: TMenuItem Caption = '&Open...' end object Save1: TMenuItem Caption = '&Save' end object SaveAs1: TMenuItem Caption = 'Save &As...' end object N2: TMenuItem Caption = '-' end object Print1: TMenuItem Caption = '&Print...' end object PrintSetup1: TMenuItem Caption = 'P&rint Setup...' end object N1: TMenuItem Caption = '-' end object Exit1: TMenuItem Caption = 'E&xit' end end object Edit2: TMenuItem Caption = '&Edit' object Undo1: TMenuItem Caption = '&Undo' ShortCutText = 'Ctrl+Z' end object Repeatcommand1: TMenuItem Caption = '&Repeat <command>' end object N5: TMenuItem Caption = '-' end object Cut1: TMenuItem Caption = 'Cu&t' ShortCutText = 'Ctrl+X' end object Copy1: TMenuItem Caption = '&Copy' ShortCutText = 'Ctrl+C' end object Paste1: TMenuItem Caption = '&Paste' ShortCutText = 'Ctrl+V' end object PasteSpecial1: TMenuItem Caption = 'Paste &Special...' end object N4: TMenuItem Caption = '-' end object Find1: TMenuItem Caption = '&Find...' end object Replace1: TMenuItem Caption = 'R&eplace...' end object GoTo1: TMenuItem Caption = '&Go To...' end object N3: TMenuItem Caption = '-' end object Links1: TMenuItem Caption = 'Lin&ks...' end object Object1: TMenuItem Caption = '&Object' end end object Help1: TMenuItem Caption = '&Help' object Contents1: TMenuItem Caption = '&Contents' end object Index1: TMenuItem Caption = '&Index' end object Commands1: TMenuItem Caption = 'Co&mmands' end object Procedures1: TMenuItem Caption = '&Procedures' end object Keyboard1: TMenuItem Caption = '&Keyboard' end object SearchforHelpOn1: TMenuItem Caption = '&Search for Help On' end object Tutorial1: TMenuItem Caption = '&Tutorial' end object HowtoUseHelp1: TMenuItem Caption = '&How to Use Help' end object About1: TMenuItem Caption = '&About...' end end end object PopupMenu1: TPopupMenu Left = 96 Top = 144 object Contents2: TMenuItem Caption = '&Contents' end object Index2: TMenuItem Caption = '&Index' end object Commands2: TMenuItem Caption = 'Co&mmands' end object Procedures2: TMenuItem Caption = '&Procedures' end object Keyboard2: TMenuItem Caption = '&Keyboard' end object SearchforHelpOn2: TMenuItem Caption = '&Search for Help On...' end object Tutorial2: TMenuItem Caption = '&Tutorial' end object HowtoUseHelp2: TMenuItem Caption = '&How to Use Help' end object About2: TMenuItem Caption = '&About...' end end end
|
||
© Copyright Marco Cantù, 1995-2020, All rights reserved |