unit main; {$DEFINE _DEBUG} interface uses Windows, Messages, SysUtils, Classes, Controls, Forms, Grids, Menus, ExtCtrls, ActnList, CheckLst, ComCtrls, ImgList, Spin, StdCtrls, ToolWin, my_apivalue, myFile, myGrid, myLabel, myListBox, mySize, myZoomImage; type //スタイルのリセットのため T_WinStyle = record hHandle : HWND; iStyle, iExStyle : Longint; end; P_WinStyle = ^T_WinStyle; T_FileProperty = record sFileName : WideString; { sFolderName : WideString; sFileSize : WideString; sCreationTime : WideString; sLastWriteTime : WideString; // sLastAccessTime : WideString; //最終アクセス時刻 } // rVersionInfo : TMyFileVersionInfo; end; P_WinInfo = ^T_WinInfo; T_WinInfo = record hHandle : HWND; sClassName : WideString; //敢えてWideString sWindowText : WideString; //敢えてWideString szWindowSize : TMyBounds; // bAeroSucceeded : Boolean; //DwmGetWindowAttribute APIが成功したかどうか rcWindowRect : TRect; // rcAeroWindowRect : TRect; // rcBasicWindowRect : TRect; rcClientRect : TRect; ptClientOrigin : TPoint; iControlID : DWORD; bUnicode : Boolean; bVisible : Boolean; bEnabled : Boolean; iStyle : Longint; iExStyle : Longint; iProcessID : Longint; iThreadID : Longint; // iWndProc : Longint; iHInstance : Longint; OrginalStyle : T_WinStyle; //スタイルの初期値 rFileProperty : T_FileProperty //実行ファイルのバージョン情報 // pParentWinInfo : P_WinInfo; end; type TApp_TOOLWindowStyle = class(TForm) ActionList1: TActionList; Action_File_OpenExeFolder: TAction; Action_File_Exit: TAction; Action_Info_Get: TAction; Action_Info_Visible: TAction; Action_Info_Cash: TAction; Action_Info_Reload: TAction; Action_Copy_Num10: TAction; Action_Copy_Num16: TAction; Action_Copy_Value: TAction; Action_Edit_WindowTreeCopy: TAction; Action_Edit_StyleCopyDisp: TAction; Action_Edit_StyleCopySelect: TAction; Action_Edit_FindHandleCopy: TAction; Action_Edit_FindHandlePaste: TAction; Action_Edit_FindHandleClear: TAction; Action_Edit_FindHandleBack: TAction; Action_Find_Handle: TAction; Action_Find_Handle10: TAction; Action_Find_Handle16: TAction; Action_Find_ClassName: TAction; Action_Find_WindowText: TAction; Action_Find_ExeName: TAction; Action_Find_TextDown: TAction; Action_Find_TextUp: TAction; Action_Style_Visible: TAction; Action_Style_Change: TAction; Action_Style_Reset: TAction; Action_Style_Button: TAction; Action_Style_Edit: TAction; Action_Style_Static: TAction; Action_Style_ComboBox: TAction; Action_Style_ListBox: TAction; Action_Style_ScrollBar: TAction; Action_CmdSystem: TAction; Action_CmdSystem_Restore: TAction; Action_CmdSystem_Move: TAction; Action_CmdSystem_Resize: TAction; Action_CmdSystem_Minimize: TAction; Action_CmdSystem_Maximize: TAction; Action_CmdSystem_Close: TAction; Action_Cmd_Terminate: TAction; Action_Cmd: TAction; Action_Cmd_TopMost: TAction; Action_Cmd_NoTopMost: TAction; Action_Cmd_SetForeground: TAction; Action_Cmd_BringToFront: TAction; Action_Cmd_SendToBack: TAction; Action_Cmd_MoveMonitor: TAction; Action_Cmd_Visible: TAction; Action_Cmd_Enabled: TAction; Action_Region: TAction; Action_Region_DefaultRegion: TAction; Action_Region_WindowRect: TAction; Action_Region_GetRgnBox: TAction; Action_Capture_Capture: TAction; Action_Capture_CaptureWindow: TAction; Action_Capture_ZoomDown: TAction; Action_Capture_ZoomUp: TAction; Action_Capture_Zoom100: TAction; Action_Capture_ZoomFit: TAction; Action_Help_VersionInfo: TAction; PopupMenu_Cmd: TPopupMenu; MenuItem_PCmd: TMenuItem; MenuItem_PCmdSystem: TMenuItem; MenuItem_PCmdSystem_Restore: TMenuItem; MenuItem_PCmdSystem_Move: TMenuItem; MenuItem_PCmdSystem_Resize: TMenuItem; MenuItem_PCmdSystem_Minimize: TMenuItem; MenuItem_PCmdSystem_Maximize: TMenuItem; MenuItem_PCmdSystem_Line1: TMenuItem; MenuItem_PCmdSystem_Close: TMenuItem; MenuItem_PCmd_Line1: TMenuItem; MenuItem_PCmd_StayOnTop: TMenuItem; MenuItem_PCmd_NoStayOnTop: TMenuItem; MenuItem_PCmd_Line2: TMenuItem; MenuItem_PCmd_Visible: TMenuItem; MenuItem_PCmd_Enabled: TMenuItem; MenuItem_PLine4: TMenuItem; MenuItem_PCmd_SetForeground: TMenuItem; MenuItem_PCmd_MoveMonitor: TMenuItem; MenuItem_PCmdStyle: TMenuItem; MenuItem_PCmdRegion: TMenuItem; MenuItem_PCmdRegion_DefaultRegion: TMenuItem; MenuItem_PCmdRegion_WindowRect: TMenuItem; MenuItem_PLine1: TMenuItem; MenuItem_PInfo_Reload: TMenuItem; MenuItem_PInfo_Visible: TMenuItem; MenuItem_PStyle_Control: TMenuItem; MenuItem_PStyle_BUTTON: TMenuItem; MenuItem_PStyle_EDIT: TMenuItem; MenuItem_PStyle_STATIC: TMenuItem; MenuItem_PStyle_COMBOBOX: TMenuItem; MenuItem_PStyle_LISTBOX: TMenuItem; MenuItem_PLine2: TMenuItem; PopupMenu_StyleControl: TPopupMenu; MenuItem_PPStyle_Button: TMenuItem; MenuItem_PPStyle_Edit: TMenuItem; MenuItem_PPStyle_Static: TMenuItem; MenuItem_PPStyle_ComboBox: TMenuItem; MenuItem_PPStyle_ListBox: TMenuItem; ToolBar_Main: TToolBar; ToolButton_Info_Reload: TToolButton; ToolButton_Info_Visible: TToolButton; ToolButton_Info_Cash: TToolButton; ToolButton_Spc1: TToolButton; ToolButton_Spc2: TToolButton; ToolButton_CmdSystem_Restore: TToolButton; ToolButton_CmdSystem_Move: TToolButton; ToolButton_CmdSystem_Resize: TToolButton; ToolButton_CmdSystem_Minimize: TToolButton; ToolButton_CmdSystem_Maximize: TToolButton; ToolButton_CmdSystem_Close: TToolButton; ToolButton_Spc3: TToolButton; ToolButton_Cmd_TopMost: TToolButton; ToolButton_Cmd_NoTopMost: TToolButton; ToolButton_Cmd_SetForeground: TToolButton; ToolButton_Cmd_BringToFront: TToolButton; ToolButton_Cmd_SendToBack: TToolButton; ToolButton_Cmd_MoveMonitor: TToolButton; ToolButton_Spc4: TToolButton; ToolButton_Cmd_Visible: TToolButton; ToolButton_Cmd_Enabled: TToolButton; ToolButton_Capture_Capture: TToolButton; ToolBar_Find: TToolBar; ToolButton_Find_Spc1: TToolButton; Panel_Find_HandleTitle: TPanel; Grid_Find_Handle: TStringGrid; Spin_Find_Handle: TSpinButton; ToolButton_Find_Handle: TToolButton; Panel_Find_TextTitle: TPanel; ComboBox_Find_Text: TComboBox; ToolButton_Find_TextDown: TToolButton; ToolButton_Find_TextUp: TToolButton; Label_ExeName: TMyLabel; Shape_Top: TShape; TreeView_Window: TTreeView; Splitter1: TSplitter; PageControl_Info: TPageControl; TabSheet_Style: TTabSheet; ListBox_Style: TListBox; Memo_Style_Edit: TMemo; Memo_Style_Button: TMemo; Memo_Style_ExStyle: TMemo; Memo_Style_Style: TMemo; Memo_Style_ListBox: TMemo; Memo_Style_ScrollBar: TMemo; Memo_Style_ComboBox: TMemo; Memo_Style_Static: TMemo; TabSheet_WinInfo: TTabSheet; Grid_WinInfo: TStringGrid; StatusBar1: TStatusBar; ImageList1: TImageList; MenuItem_PCmd_BringToFront: TMenuItem; MenuItem_PCmd_SendToBack: TMenuItem; mniPCapture_Capture: TMenuItem; MenuItem_PInfo_Cash: TMenuItem; PopupMenu_FindHandle: TPopupMenu; MenuItem_PEdit_FindHandleCopy: TMenuItem; MenuItem_PEdit_FindHandlePaste: TMenuItem; MenuItem_PEdit_FindHandleClear: TMenuItem; MenuItem_PEdit_FindHandleBack: TMenuItem; MenuItem_PEdit_FindHandleLine1: TMenuItem; MenuItem_PFind_Handle: TMenuItem; MenuItem_PEdit_FindHandleLine2: TMenuItem; MenuItem_PFind_Handle16: TMenuItem; MenuItem_PEdit_WindowTreeCopy: TMenuItem; PopupMenu_CopyValue: TPopupMenu; MenuItem_PCopy_Value: TMenuItem; MenuItem_PCopy_Num16: TMenuItem; MenuItem_PCopy_Num10: TMenuItem; PopupMenu_StyleCopy: TPopupMenu; MainMenu1: TMainMenu; MenuItem_File: TMenuItem; MenuItem_Edit: TMenuItem; MenuItem_Info_Visible: TMenuItem; MenuItem_Info_Cash: TMenuItem; MenuItem_Info_Reload: TMenuItem; MenuItem_Edit_Line3: TMenuItem; MenuItem_PLine3: TMenuItem; MenuItem_Style: TMenuItem; MenuItem_Style_BUTTON: TMenuItem; MenuItem_Style_EDIT: TMenuItem; MenuItem_Style_STATIC: TMenuItem; MenuItem_Style_COMBOBOX: TMenuItem; MenuItem_Style_LISTBOX: TMenuItem; MenuItem_Style_Line1: TMenuItem; MenuItem_Style_Change: TMenuItem; mniWinInfoCopy: TMenuItem; mniEdit_WindowTreeCopy: TMenuItem; mniEdit_StyleCopySelect: TMenuItem; MenuItem_PEdit_StyleCopySelect: TMenuItem; MenuItem_Edit_Line1: TMenuItem; MenuItem_Edit_Line2: TMenuItem; MenuItem_PEdit_StyleCopyDisp: TMenuItem; MenuItem_Style_ScrollBar: TMenuItem; MenuItem_PStyle_ScrollBar: TMenuItem; mniEdit_StyleCopyDisp: TMenuItem; MenuItem_PPStyle_ScrollBar: TMenuItem; MenuItem_File_Exit: TMenuItem; MenuItem_Help: TMenuItem; MenuItem_Help_VersionInfo: TMenuItem; MenuItem_File_Line2: TMenuItem; MenuItem_CmdSystem: TMenuItem; MenuItem_CmdSystem_Move: TMenuItem; MenuItem_CmdSystem_Resize: TMenuItem; MenuItem_CmdSystem_Minimize: TMenuItem; MenuItem_CmdSystem_Maximize: TMenuItem; MenuItem_CmdSystem_Line1: TMenuItem; MenuItem_CmdSystem_Close: TMenuItem; MenuItem_CmdSystem_Restore: TMenuItem; MenuItem_Cmd: TMenuItem; MenuItem_Cmd_TopMost: TMenuItem; MenuItem_Cmd_NoTopMost: TMenuItem; MenuItem_Cmd_SetForeground: TMenuItem; MenuItem_Cmd_MoveMonitor: TMenuItem; MenuItem_Cmd_Line1: TMenuItem; MenuItem_Cmd_BringToFront: TMenuItem; MenuItem_Cmd_SendToBack: TMenuItem; MenuItem_Cmd_Line2: TMenuItem; MenuItem_Cmd_Visible: TMenuItem; MenuItem_Cmd_Enabled: TMenuItem; MenuItem_Capture_Capture: TMenuItem; MenuItem_Disp: TMenuItem; MenuItem_CmdRegion: TMenuItem; MenuItem_CmdRegion_DefaultRegion: TMenuItem; MenuItem_CmdRegion_WindowRect: TMenuItem; MenuItem_CmdRegion_GetRgnBox: TMenuItem; MenuItem_PCmdRegion_GetRgnBox: TMenuItem; ToolBar1: TToolBar; ToolButton_Style_Button: TToolButton; ToolButton_Style_Edit: TToolButton; ToolButton_Style_Static: TToolButton; ToolButton_Style_ComboBox: TToolButton; ToolButton_Style_ListBox: TToolButton; ToolButton_Style_ScrollBar: TToolButton; ToolButton_Style_Spc1: TToolButton; ToolButton_Edit_StyleCopySelect: TToolButton; ToolButton_Edit_StyleCopyDisp: TToolButton; Panel_Find_Handle_Radio: TPanel; Panel_Find_TextRadio: TPanel; RadioButton_Find_WindowText: TRadioButton; RadioButton_Find_ClassName: TRadioButton; RadioButton_Find_ExeName: TRadioButton; ToolButton_Find_Spc2: TToolButton; Label_Find: TMyLabel; TabSheet_FileProperty: TTabSheet; Grid_FileProperty: TStringGrid; MenuItem_CmdSystem_Line2: TMenuItem; MenuItem_Cmd_Terminate: TMenuItem; MenuItem_PCmdSystem_Line2: TMenuItem; MenuItem_PCmd_Terminate: TMenuItem; ToolButton1: TToolButton; MenuItem_File_Line1: TMenuItem; MenuItem_File_OpenExeFolder: TMenuItem; TabSheet_Capture: TTabSheet; Panel_BitmapBase: TPanel; Label_Stretch: TLabel; Image_Bitmap: TImage; Grid_Bitmap: TDrawGrid; Label_BitmapEmpty: TLabel; RichEdit_Hint: TRichEdit; Splitter2: TSplitter; TabSheet_API: TTabSheet; ComboBox_FindNum: TComboBox; Memo_Style_TrackBar: TMemo; Action_Style_TrackBar: TAction; ToolButton2: TToolButton; TabSheet_APITest: TTabSheet; PageControl_APITest: TPageControl; TabSheet_APITestSelect: TTabSheet; CheckListBox_APITestSelect: TCheckListBox; TabSheet_APITestResult: TTabSheet; RichEdit_APITestSelectHint: TRichEdit; Splitter_APITestSelect: TSplitter; StringGrid_APITestResult: TStringGrid; Panel_FileInfo_IconImage: TPanel; Image1: TImage; MenuItem_PStyle_TrackBar: TMenuItem; MenuItem_PPStyle_TrackBar: TMenuItem; RadioButton_Find_Handle16: TRadioButton; RadioButton_Find_Handle10: TRadioButton; procedure actNop (Sender: TObject); procedure Action_File_OpenExeFolderExecute (Sender: TObject); procedure Action_File_ExitExecute (Sender: TObject); procedure Action_Info_ReloadExecute (Sender: TObject); procedure Action_Info_CashExecute (Sender: TObject); procedure Action_Info_GetExecute (Sender: TObject); procedure Action_Copy_ValueExecute (Sender: TObject); procedure Action_Copy_Num10Execute (Sender: TObject); procedure Action_Copy_Num16Execute (Sender: TObject); procedure Action_Edit_FindHandleBackExecute (Sender: TObject); procedure Action_Edit_FindHandleClearExecute (Sender: TObject); procedure Action_Edit_FindHandlePasteExecute (Sender: TObject); procedure Action_Edit_FindHandleCopyExecute (Sender: TObject); procedure Action_Edit_WindowTreeCopyExecute (Sender: TObject); procedure Action_Edit_StyleCopySelectExecute (Sender: TObject); procedure Action_Edit_StyleCopyDispExecute (Sender: TObject); procedure Action_Find_HandleExecute (Sender: TObject); procedure Action_Find_Handle16Execute (Sender: TObject); procedure Action_Find_TextDownExecute (Sender: TObject); procedure Action_Style_ChangeExecute (Sender: TObject); procedure Action_Style_ButtonExecute (Sender: TObject); procedure Action_Capture_CaptureExecute (Sender: TObject); procedure Action_Capture_CaptureWindowExecute(Sender: TObject); procedure Action_Capture_ZoomUpExecute (Sender: TObject); procedure Action_Capture_Zoom100Execute (Sender: TObject); procedure Action_Capture_ZoomFitExecute (Sender: TObject); procedure Action_CmdSystem_RestoreExecute (Sender: TObject); procedure Action_CmdSystem_MoveExecute (Sender: TObject); procedure Action_CmdSystem_ResizeExecute (Sender: TObject); procedure Action_CmdSystem_MinimizeExecute (Sender: TObject); procedure Action_CmdSystem_MaximizeExecute (Sender: TObject); procedure Action_CmdSystem_CloseExecute (Sender: TObject); procedure Action_Cmd_TerminateExecute (Sender: TObject); procedure Action_Cmd_TopMostExecute (Sender: TObject); procedure Action_Cmd_NoTopMostExecute (Sender: TObject); procedure Action_Cmd_BringToFrontExecute (Sender: TObject); procedure Action_Cmd_SendToBackExecute (Sender: TObject); procedure Action_Cmd_VisibleExecute (Sender: TObject); procedure Action_Cmd_EnabledExecute (Sender: TObject); procedure Action_Cmd_SetForegroundExecute (Sender: TObject); procedure Action_Cmd_MoveMonitorExecute (Sender: TObject); procedure Action_Region_DefaultRegionExecute (Sender: TObject); procedure Action_Region_GetRgnBoxExecute (Sender: TObject); procedure Action_Region_WindowRectExecute (Sender: TObject); procedure Action_Help_VersionInfoExecute (Sender: TObject); procedure PopupMenu_FindHandlePopup(Sender: TObject); procedure PopupMenu_CopyValuePopup(Sender: TObject); procedure PopupMenu_StyleCopyPopup(Sender: TObject); procedure PopupMenu_CmdPopup(Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormDestroy(Sender: TObject); procedure TreeView_WindowChange (Sender: TObject; Node: TTreeNode); procedure TreeView_WindowCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure TreeView_WindowDblClick (Sender: TObject); procedure ListBox_StyleDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure ListBox_StyleClick (Sender: TObject); procedure ListBox_StyleMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Spin_Find_HandleDownClick(Sender: TObject); procedure Spin_Find_HandleUpClick (Sender: TObject); procedure Grid_Find_HandleDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure Grid_Find_HandleKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Grid_Find_HandleKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure Grid_WinInfoMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Grid_WinInfoDrawCell (Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); procedure Grid_WinInfoMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Grid_BitmapMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure Grid_BitmapMouseWheelUp (Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure Image_BitmapDblClick (Sender: TObject); procedure Image_BitmapMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Image_BitmapMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Image_BitmapMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure TabSheet_WinInfoResize (Sender: TObject); procedure TabSheet_CaptureShow(Sender: TObject); procedure TabSheet_APITestResultResize(Sender: TObject); procedure PageControl_APITestChange(Sender: TObject); procedure CheckListBox_APITestSelectClick(Sender: TObject); private { Private 宣言 } FbThrough : Boolean; //処理しきれないメッセージをスルー FbEvent : Boolean; FhHandle : HWND; FNode : TTreeNode; FToplevelNode : TTreeNode; FbChanging : Boolean; FCopyPos : TPoint; FAPIValue : T_MyAPIValue; procedure WMMouseActivate(var Msg: TWMMOUSEACTIVATE); message WM_MOUSEACTIVATE; //システム終了 procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; procedure FSetTitle(AGrid: TStringGrid; iRow: Integer; sTitle: String); procedure FSetValue(AGrid: TStringGrid; iRow: Integer; sValue: String); procedure FSetStretchCaption; procedure FSetCmdEnabled(hWindow: HWND); function FIsNum(iCode: Word) : Boolean; function FGetNum(iNum: Int64) : String; overload; function FGetNum(sNum: String): DWORD; overload; function FGetHandle: DWORD; function FIncNum(sNum: String; iInc : Integer = 0): String; procedure FSetWindowInfo(AInfo: T_WinInfo); procedure FSetFileInfo;// (AInfo: T_WinInfo); procedure FSetStyleInfo(AInfo: T_WinInfo); procedure FDoAPITest; function FLoadIni: Boolean; procedure FSaveIni; function FCheckHungup : Boolean; function FGetFindHandleText : String; procedure FSetFindHandleText(sValue : String); property FHandleText : String read FGetFindHandleText write FSetFindHandleText; public { Public 宣言 } function GetStyleValue(sStr: String): Longint; property TgtHandle: HWND read FhHandle; end; var App_TOOLWindowStyle : TApp_TOOLWindowStyle; implementation uses {$IFDEF _DEBUG} myDebug, {$ENDIF} Clipbrd, CommCtrl, Graphics, myApp, myControl, myFind, myGraphic, myHelpVersionInfo, myImage, myIniFile, myInputNum, myDrawGrid, myMessageDlg, myMonitor, myMultiMonitor, myNum, myString, myType, myWindow, style, image; const Fci_MARGIN = 2; Fci_STYLEPOS = 10; //数値を取り出すため const Fci_INFO_HANDLE = 1; Fcs_TITLE_HANDLE = 'ハンドル'; Fcs_FMT_HANDLE = '0x%s %u'; Fci_INFO_CLASSNAME = 2; Fcs_TITLE_CLASSNAME = 'クラス名'; Fcs_FMT_CLASSNAME = '%s'; Fci_INFO_TEXT = 3; Fcs_TITLE_TEXT = 'テキスト'; Fcs_FMT_TEXT = '%s'; Fci_INFO_WINDOWSIZE = 4; Fcs_TITLE_WINDOWSIZE = 'ウィンドウサイズ'; Fcs_FMT_WINDOWSIZE = '(%d, %d) %d × %d'; Fci_INFO_CLIENTSIZE = 5; Fcs_TITLE_CLIENTSIZE = 'クライアントサイズ'; Fcs_FMT_CLIENTSIZE = '%d × %d'; Fci_INFO_CLIENTORIGIN = 6; Fcs_TITLE_CLIENTORIGIN = 'クライアント原点'; Fcs_FMT_CLIENTORIGIN = '(%d, %d)'; Fci_INFO_WINDOWRECT = 7; Fcs_TITLE_WINDOWRECT = 'RECT'; Fcs_FMT_WINDOWRECT = '(%d, %d, %d, %d)'; // Fci_INFO_AERORECT = 8; Fcs_TITLE_AERORECT = ' DwmGetWindowAttribute API'; Fcs_FMT_AERORECT = '(%d, %d, %d, %d)'; // Fci_INFO_BASICRECT = 9; Fcs_TITLE_BASICRECT = ' GetWindowRect API'; Fcs_FMT_BASICRECT = '(%d, %d, %d, %d)'; Fci_INFO_CONTROLID = 8; Fcs_TITLE_CONTROLID = 'コントロールID'; Fcs_FMT_CONTROLID = '0x%s %u'; Fci_INFO_UNICODE = 9; Fcs_TITLE_UNICODE = 'Unicode'; Fci_INFO_VISIBLE = 10; Fcs_TITLE_VISIBLE = 'Visible'; Fci_INFO_ENABLED = 11; Fcs_TITLE_ENABLED = 'Enabled'; Fci_INFO_PROCESSID = 12; Fcs_TITLE_PROCESSID = 'プロセスID(PID)'; Fci_INFO_THREADID = 13; Fcs_TITLE_THREADID = 'スレッドID'; // Fci_INFO_WNDPROC = 14; Fcs_TITLE_WNDPROC = 'ウィンドウプロシージャ'; Fcs_FMT_WNDPROC = '%s %d'; Fci_INFO_HINSTANCE = 14; Fcs_TITLE_HINSTANCE = 'アプリケーションインスタンス'; Fcs_FMT_HINSTANCE = '0x%s %u'; Fci_INFO_COUNT = 15; const Fci_PROPERTY_EXENAME = 1; Fcs_PROPERTY_TITLE_EXENAME = 'ファイル名'; Fci_PROPERTY_EXEPATH = 2; Fcs_PROPERTY_TITLE_EXEPATH = '場所'; Fci_PROPERTY_FILESIZE = 3; Fcs_PROPERTY_TITLE_FILESIZE = 'サイズ'; Fci_PROPERTY_CREATETIME = 4; Fcs_PROPERTY_TITLE_CREATETIME = '作成日時'; Fci_PROPERTY_UPDATETIME = 5; Fcs_PROPERTY_TITLE_UPDATETIME = '更新日時'; Fci_PROPERTY_ACCESSTIME = 6; Fcs_PROPERTY_TITLE_ACCESSTIME = 'アクセス日時'; Fci_PROPERTY_FILEDESCRIPTION = 7; Fcs_PROPERTY_TITLE_FILEDESCRIPTION = 'ファイルの説明'; //説明 Fci_PROPERTY_BINARYTYPE = 8; Fcs_PROPERTY_TITLE_BINARYTYPE = 'バイナリータイプ'; Fci_PROPERTY_FILEVERSION = 9; Fcs_PROPERTY_TITLE_FILEVERSION = 'ファイルバージョン'; //ファイルバージョン Fci_PROPERTY_PRODUCTNAME = 10; Fcs_PROPERTY_TITLE_PRODUCTNAME = '製品名'; //製品名 Fci_PROPERTY_PRODUCTVERSION = 11; Fcs_PROPERTY_TITLE_PRODUCTVERSION = '製品バージョン'; //製品バージョン Fci_PROPERTY_LEGALCOPYRIGHT = 12; Fcs_PROPERTY_TITLE_LEGALCOPYRIGHT = '著作権'; //著作権 Fci_PROPERTY_LANGUAGE = 13; Fcs_PROPERTY_TITLE_LANGUAGE = '言語'; Fci_PROPERTY_LEGALTRADEMARKS = 14; Fcs_PROPERTY_TITLE_LEGALTRADEMARKS = '商標'; //商標 Fci_PROPERTY_ORIGINALFILENAME = 15; Fcs_PROPERTY_TITLE_ORIGINALFILENAME = '元のファイル名'; //正式ファイル名 Fci_PROPERTY_COMMENTS = 16; Fcs_PROPERTY_TITLE_COMMENTS = 'コメント'; //コメント Fci_PROPERTY_COMPANYNAME = 17; Fcs_PROPERTY_TITLE_COMPANYNAME = '会社名'; //会社名 Fci_PROPERTY_INTERNALNAME = 18; Fcs_PROPERTY_TITLE_INTERNALNAME = '内部名'; //内部名 Fci_PROPERTY_PRIVATEBUILD = 19; Fcs_PROPERTY_TITLE_PRIVATEBUILD = 'プライベートビルド情報'; //プライベートビルド情報 Fci_PROPERTY_SPECIALBUILD = 20; Fcs_PROPERTY_TITLE_SPECIALBUILD = 'スペシャルビルド情報'; //スペシャルビルド情報 Fci_PROPERTY_COUNT = 21; const Fci_COL_ELEMENT = 0; Fci_COL_RESULT = 1; Fci_COL_HINT = 2; Fci_ROW_TITLE = 0; Fcs_TITLE_ELEMENT = '項目'; Fcs_TITLE_RESULT = '値'; Fcs_TITLE_HINT = '補足'; const //ツリービューのフォーマット Fcs_FMT_TREEVIEW = '%s %s (%d,%d %dx%d) "%s" %s'; {$R *.dfm} function F_GetHandleString(iNum : DWORD): String; begin // Result := LowerCase(IntToHex(hHandle, 8)); Result := Format(Fcs_FMT_HANDLE, [LowerCase(IntToHex(iNum, 8)), iNum]); end; function F_GetClassName(hHandle: HWND): String; {2007-06-09: ウィンドウハンドルhHandleのクラス名を返す } const lci_LEN = 256; var li_Len : Integer; begin SetLength(Result, lci_LEN); li_Len := GetClassName(hHandle, PChar(Result), lci_LEN -1); SetLength(Result, li_Len); end; procedure F_GetWinInfo(var pInfo: P_WinInfo; hHandle: HWND); //var // lf_Size : Extended; begin if (pInfo = nil) then begin pInfo := AllocMem(SizeOf(pInfo^)); end; //ウィンドウ情報 pInfo^.hHandle := hHandle; pInfo^.sClassName := F_GetClassName(hHandle); // pInfo^.sWindowText := gfnsWindowTextGet(hHandle, True); pInfo^.sWindowText := gfnsWindowTextGet(hHandle); pInfo^.szWindowSize := gfnszWindowSizeGet(hHandle); pInfo^.rcWindowRect := gfnrcWindowRectGet(hHandle); pInfo^.rcClientRect := gfnrcClientRectGet(hHandle); pInfo^.ptClientOrigin := gfnptClientToScreen(hHandle); pInfo^.iControlID := GetWindowLong(hHandle, GWL_ID); pInfo^.bUnicode := IsWindowUnicode(hHandle); pInfo^.bVisible := IsWindowVisible(hHandle); pInfo^.bEnabled := IsWindowEnabled(hHandle); pInfo^.iStyle := GetWindowLong(hHandle, GWL_STYLE); //ウィンドウスタイル pInfo^.iExStyle := GetWindowLong(hHandle, GWL_EXSTYLE); //拡張ウィンドウスタイル pInfo^.iProcessID := gfniProcessIDGet(hHandle); pInfo^.iThreadID := gfniThreadIDGet(hHandle); { try AttachThreadInput(gfniThreadIDGet(pInfo^.iThreadID), gfniThreadIDGet(App_TOOLWindowStyle.Handle), True); pInfo^.iWndProc := GetWindowLong(hHandle, GWL_WNDPROC); finally AttachThreadInput(gfniThreadIDGet(pInfo^.iThreadID), gfniThreadIDGet(App_TOOLWindowStyle.Handle), False); end; } pInfo^.iHInstance := GetWindowLong(hHandle, GWL_HINSTANCE); //ファイル情報 pInfo^.rFileProperty.sFileName := gfnsExeNameGet(hHandle); { pInfo^.rFileProperty.sFolderName := gfnsFileDirGet(pInfo^.rFileProperty.sFileName); lf_Size := gfniFileSizeGet(pInfo^.rFileProperty.sFileName); pInfo^.rFileProperty.sFileSize := Format('%s (%.0n バイト)', [gfnsFileSizeStringGet(pInfo^.rFileProperty.sFileName, 2), lf_Size]); pInfo^.rFileProperty.sCreationTime := gfnsFileCreationTimeStringGet(pInfo^.rFileProperty.sFileName); pInfo^.rFileProperty.sLastWriteTime := gfnsFileLastWriteTimeStringGet(pInfo^.rFileProperty.sFileName); pInfo^.rFileProperty.sLastAccessTime := gfnsFileLastAccessTimeStringGet(pInfo^.rFileProperty.sFileName); // pInfo^.rFileProperty.rVersionInfo := gfnrFileVersionInfoGet(pInfo^.rFileProperty.sFileName); } //ウィンドウスタイル pInfo^.OrginalStyle.iStyle := pInfo^.iStyle; //スタイルの初期値 pInfo^.OrginalStyle.iExStyle := pInfo^.iExStyle; //拡張スタイルの初期値 pInfo^.OrginalStyle.hHandle := pInfo^.hHandle; end; function F_GetTreeViewCaption(AInfo: T_WinInfo; sExeName: String = ''): String; begin Result := Format(Fcs_FMT_TREEVIEW, [ F_GetHandleString(AInfo.hHandle), AInfo.sClassName, AInfo.szWindowSize.Left, AInfo.szWindowSize.Top, AInfo.szWindowSize.Width, AInfo.szWindowSize.Height, AInfo.sWindowText, sExeName ] ); end; function TApp_TOOLWindowStyle.GetStyleValue(sStr: String): Longint; begin Result := Longint(gfniStrToInt(Trim(Copy(sStr, 1, Fci_STYLEPOS)))); end; procedure TApp_TOOLWindowStyle.FormCreate(Sender: TObject); var i: Integer; begin {$IFDEF _DEBUG} // gpcMessageModeSet(True); {$ENDIF} Tag := 0; FbThrough := False; FCopyPos := Point(0, 0); // SetWindowLong(Edit_FindHandle.Handle, GWL_STYLE, GetWindowLong(Edit_FindHandle.Handle, GWL_STYLE) or ES_RIGHT); Grid_Find_Handle.ColWidths [0] := Grid_Find_Handle.ClientWidth; Grid_Find_Handle.RowHeights[0] := Grid_Find_Handle.ClientHeight; //ウィンドウ情報 with Grid_WinInfo do begin RowCount := Fci_INFO_COUNT; Cells[0, 0] := '項目'; Cells[1, 0] := '値'; //行の高さをセット DefaultRowHeight := Self.Canvas.TextHeight('A') + Fci_MARGIN * 2; Align := alClient; end; FSetTitle(Grid_WinInfo, Fci_INFO_HANDLE, Fcs_TITLE_HANDLE); //ハンドル FSetTitle(Grid_WinInfo, Fci_INFO_CLASSNAME, Fcs_TITLE_CLASSNAME); //クラス名 FSetTitle(Grid_WinInfo, Fci_INFO_TEXT, Fcs_TITLE_TEXT); //テキスト FSetTitle(Grid_WinInfo, Fci_INFO_WINDOWSIZE, Fcs_TITLE_WINDOWSIZE); //ウィンドウサイズ FSetTitle(Grid_WinInfo, Fci_INFO_CLIENTSIZE, Fcs_TITLE_CLIENTSIZE); //クライアントサイズ FSetTitle(Grid_WinInfo, Fci_INFO_CLIENTORIGIN, Fcs_TITLE_CLIENTORIGIN); //クライアント原点 FSetTitle(Grid_WinInfo, Fci_INFO_WINDOWRECT, Fcs_TITLE_WINDOWRECT); //RECT // FSetTitle(Grid_WinInfo, Fci_INFO_AERORECT, Fcs_TITLE_AERORECT); //Aero Rect // FSetTitle(Grid_WinInfo, Fci_INFO_BASICRECT, Fcs_TITLE_BASICRECT); //Basic Rect FSetTitle(Grid_WinInfo, Fci_INFO_CONTROLID, Fcs_TITLE_CONTROLID); //コントロールID FSetTitle(Grid_WinInfo, Fci_INFO_UNICODE, Fcs_TITLE_UNICODE); //Unicode FSetTitle(Grid_WinInfo, Fci_INFO_VISIBLE, Fcs_TITLE_VISIBLE); //Visible FSetTitle(Grid_WinInfo, Fci_INFO_ENABLED, Fcs_TITLE_ENABLED); //Enabled FSetTitle(Grid_WinInfo, Fci_INFO_PROCESSID, Fcs_TITLE_PROCESSID); //プロセスID(PID) FSetTitle(Grid_WinInfo, Fci_INFO_THREADID, Fcs_TITLE_THREADID); //スレッドID FSetTitle(Grid_WinInfo, Fci_INFO_HINSTANCE, Fcs_TITLE_HINSTANCE); //アプリケーションインスタンス //ファイル情報 with Grid_FileProperty do begin RowCount := Fci_PROPERTY_COUNT; Cells[0, 0] := '項目'; Cells[1, 0] := '値'; //行の高さをセット DefaultRowHeight := Self.Canvas.TextHeight('A') + Fci_MARGIN * 2; Align := alClient; end; FSetTitle(Grid_FileProperty, Fci_PROPERTY_EXENAME, Fcs_PROPERTY_TITLE_EXENAME); //ファイル名 FSetTitle(Grid_FileProperty, Fci_PROPERTY_EXEPATH, Fcs_PROPERTY_TITLE_EXEPATH); //場所 FSetTitle(Grid_FileProperty, Fci_PROPERTY_FILESIZE, Fcs_PROPERTY_TITLE_FILESIZE); //サイズ FSetTitle(Grid_FileProperty, Fci_PROPERTY_CREATETIME, Fcs_PROPERTY_TITLE_CREATETIME); //作成日時 FSetTitle(Grid_FileProperty, Fci_PROPERTY_UPDATETIME, Fcs_PROPERTY_TITLE_UPDATETIME); //更新日時 FSetTitle(Grid_FileProperty, Fci_PROPERTY_ACCESSTIME, Fcs_PROPERTY_TITLE_ACCESSTIME); //アクセス日時 FSetTitle(Grid_FileProperty, Fci_PROPERTY_COMMENTS, Fcs_PROPERTY_TITLE_COMMENTS); //コメント FSetTitle(Grid_FileProperty, Fci_PROPERTY_COMPANYNAME, Fcs_PROPERTY_TITLE_COMPANYNAME); //会社名 FSetTitle(Grid_FileProperty, Fci_PROPERTY_FILEDESCRIPTION, Fcs_PROPERTY_TITLE_FILEDESCRIPTION); //説明 FSetTitle(Grid_FileProperty, Fci_PROPERTY_FILEVERSION, Fcs_PROPERTY_TITLE_FILEVERSION); //ファイルバージョン FSetTitle(Grid_FileProperty, Fci_PROPERTY_INTERNALNAME, Fcs_PROPERTY_TITLE_INTERNALNAME); //内部名 FSetTitle(Grid_FileProperty, Fci_PROPERTY_LEGALCOPYRIGHT, Fcs_PROPERTY_TITLE_LEGALCOPYRIGHT); //著作権 FSetTitle(Grid_FileProperty, Fci_PROPERTY_LEGALTRADEMARKS, Fcs_PROPERTY_TITLE_LEGALTRADEMARKS); //商標 FSetTitle(Grid_FileProperty, Fci_PROPERTY_ORIGINALFILENAME, Fcs_PROPERTY_TITLE_ORIGINALFILENAME); //正式ファイル名 FSetTitle(Grid_FileProperty, Fci_PROPERTY_PRODUCTNAME, Fcs_PROPERTY_TITLE_PRODUCTNAME); //製品名 FSetTitle(Grid_FileProperty, Fci_PROPERTY_PRODUCTVERSION, Fcs_PROPERTY_TITLE_PRODUCTVERSION); //製品バージョン FSetTitle(Grid_FileProperty, Fci_PROPERTY_PRIVATEBUILD, Fcs_PROPERTY_TITLE_PRIVATEBUILD); //プライベートビルド情報 FSetTitle(Grid_FileProperty, Fci_PROPERTY_SPECIALBUILD, Fcs_PROPERTY_TITLE_SPECIALBUILD); //スペシャルビルド情報 FSetTitle(Grid_FileProperty, Fci_PROPERTY_BINARYTYPE, Fcs_PROPERTY_TITLE_BINARYTYPE); //バイナリータイプ FSetTitle(Grid_FileProperty, Fci_PROPERTY_LANGUAGE, Fcs_PROPERTY_TITLE_LANGUAGE); //スタイル Memo_Style_Style.SetBounds (0, 0, 0, 0); Memo_Style_ExStyle.SetBounds (0, 0, 0, 0); Memo_Style_Button.SetBounds (0, 0, 0, 0); Memo_Style_Edit.SetBounds (0, 0, 0, 0); Memo_Style_Static.SetBounds (0, 0, 0, 0); Memo_Style_ComboBox.SetBounds(0, 0, 0, 0); Memo_Style_ListBox.SetBounds (0, 0, 0, 0); Memo_Style_TrackBar.SetBounds(0, 0, 0, 0); //ウィンドウ画像 Image_Bitmap.Parent := Grid_Bitmap; // Label_Stretch.Parent := Grid_Bitmap; //多分TToolBarのバグによるレイアウトの不具合への対処。 Panel_Find_Handle_Radio.Width := RadioButton_Find_Handle10.Width + RadioButton_Find_Handle16.Width; Panel_Find_Handle_Radio.ParentColor := True; Panel_Find_TextRadio.Width := RadioButton_Find_ClassName.Width + RadioButton_Find_ExeName.Width + RadioButton_Find_WindowText.Width; Panel_Find_TextRadio.ParentColor := True; Panel_BitmapBase.Align := alClient; Image_Bitmap.Align := alClient; Label_BitmapEmpty.Align := alClient; Grid_Bitmap.Align := alClient; Grid_Bitmap.DoubleBuffered := True; //APITest PageControl_APITest.ActivePage := TabSheet_APITestSelect; with StringGrid_APITestResult do begin Align := alClient; Cells[Fci_COL_ELEMENT, Fci_ROW_TITLE] := Fcs_TITLE_ELEMENT; Cells[Fci_COL_RESULT, Fci_ROW_TITLE] := Fcs_TITLE_RESULT; DefaultRowHeight := Self.Canvas.TextHeight('A') + Fci_MARGIN * 2; end; FAPIValue := T_MyAPIValue.Create; for i := 0 to FAPIValue.Items.Count -1 do begin CheckListBox_APITestSelect.Items.Add(FAPIValue.Items[i]); end; Label_ExeName.Caption := ''; // ListBox_Style.Align := alClient; PageControl_Info.Align := alClient; PageControl_Info.ActivePage := TabSheet_WinInfo; Action_Info_CashExecute(nil); Tag := 1; //開始 if not(FLoadIni) then begin TreeView_Window.Width := Self.ClientWidth div 2; Action_Info_CashExecute(nil); end else if (gfnbKeyState(VK_SHIFT)) then begin TreeView_Window.Width := Self.ClientWidth div 2; end; Show; Action_Info_ReloadExecute(nil); TreeView_Window.Select(TreeView_Window.Items[0]); TreeView_WindowChange(nil, TreeView_Window.Selections[0]); gpcFormBringToFront(Self); end; procedure TApp_TOOLWindowStyle.FormDestroy(Sender: TObject); //破棄 begin Tag := 0; FSaveIni; gpcTreeViewClear(TreeView_Window); FAPIValue.Free; end; procedure TApp_TOOLWindowStyle.WMQueryEndSession(var Msg: TWMQueryEndSession); begin //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm FormDestroy(Self); Msg.Result := 1; end; procedure TApp_TOOLWindowStyle.FSetWindowInfo(AInfo: T_WinInfo); begin FSetValue(Grid_WinInfo, Fci_INFO_HANDLE, F_GetHandleString(AInfo.hHandle)); FSetValue(Grid_WinInfo, Fci_INFO_CLASSNAME, AInfo.sClassName); FSetValue(Grid_WinInfo, Fci_INFO_TEXT, AInfo.sWindowText); FSetValue(Grid_WinInfo, Fci_INFO_WINDOWSIZE, Format(Fcs_FMT_WINDOWSIZE, [AInfo.szWindowSize.Left, AInfo.szWindowSize.Top, AInfo.szWindowSize.Width, AInfo.szWindowSize.Height])); FSetValue(Grid_WinInfo, Fci_INFO_CLIENTSIZE, Format(Fcs_FMT_CLIENTSIZE, [AInfo.rcClientRect.Right, AInfo.rcClientRect.Bottom])); FSetValue(Grid_WinInfo, Fci_INFO_CLIENTORIGIN, Format(Fcs_FMT_CLIENTORIGIN, [AInfo.ptClientOrigin.X, AInfo.ptClientOrigin.Y])); FSetValue(Grid_WinInfo, Fci_INFO_WINDOWRECT, Format(Fcs_FMT_WINDOWRECT, [AInfo.rcWindowRect.Left, AInfo.rcWindowRect.Top, AInfo.rcWindowRect.Right, AInfo.rcWindowRect.Bottom])); FSetValue(Grid_WinInfo, Fci_INFO_CONTROLID, Format(Fcs_FMT_CONTROLID, [LowerCase(IntToHex(AInfo.iControlID, 8)), AInfo.iControlID])); FSetValue(Grid_WinInfo, Fci_INFO_UNICODE, gfnsBoolToStr(AInfo.bUnicode)); FSetValue(Grid_WinInfo, Fci_INFO_VISIBLE, gfnsBoolToStr(AInfo.bVisible)); FSetValue(Grid_WinInfo, Fci_INFO_ENABLED, gfnsBoolToStr(AInfo.bEnabled)); FSetValue(Grid_WinInfo, Fci_INFO_PROCESSID, F_GetHandleString(AInfo.iProcessID)); FSetValue(Grid_WinInfo, Fci_INFO_THREADID, F_GetHandleString(AInfo.iThreadID)); FSetValue(Grid_WinInfo, Fci_INFO_HINSTANCE, F_GetHandleString(AInfo.iHInstance)); end; procedure TApp_TOOLWindowStyle.FSetFileInfo; //(AInfo: T_WinInfo); function _GetBinaryType(iValue: DWORD): WideString; const SCS_64BIT_BINARY = 6; begin case iValue of SCS_32BIT_BINARY: Result := 'Windows 32bitアプリケーション'; SCS_64BIT_BINARY: Result := 'Windows 64bitアプリケーション'; SCS_DOS_BINARY: Result := 'MS-DOSベースのアプリケーション'; SCS_OS216_BINARY: Result := '16bit版OS/2ベースのアプリケーション'; SCS_PIF_BINARY: Result := 'MS-DOSベースのアプリケーションを実行するPIFファイル'; SCS_POSIX_BINARY: Result := 'POSIXベースのアプリケーション'; SCS_WOW_BINARY: Result := 'Windows 16bitアプリケーション'; else Result := '不明'; end; end; var ls_File : String; lf_Size : Extended; l_VerInfo : TMyFileVersionInfo; li_Type : DWORD; begin ls_File := gfnsExeNameGet(FhHandle); FSetValue(Grid_FileProperty, Fci_PROPERTY_EXENAME, ExtractFileName(ls_File)); FSetValue(Grid_FileProperty, Fci_PROPERTY_EXEPATH, gfnsFileDirGet(ls_File)); lf_Size := gfniFileSizeGet(ls_File); FSetValue(Grid_FileProperty, Fci_PROPERTY_FILESIZE, Format('%s (%.0n バイト)', [gfnsFileSizeStringGet(ls_File, 2), lf_Size])); FSetValue(Grid_FileProperty, Fci_PROPERTY_CREATETIME, gfnsFileCreationTimeStringGet(ls_File)); FSetValue(Grid_FileProperty, Fci_PROPERTY_UPDATETIME, gfnsFileLastWriteTimeStringGet(ls_File)); FSetValue(Grid_FileProperty, Fci_PROPERTY_ACCESSTIME, gfnsFileLastAccessTimeStringGet(ls_File)); if (GetBinaryType(PChar(ls_File), li_Type)) then FSetValue(Grid_FileProperty, Fci_PROPERTY_BINARYTYPE, _GetBinaryType(li_Type)) else FSetValue(Grid_FileProperty, Fci_PROPERTY_BINARYTYPE, ''); l_VerInfo := gfnrFileVersionInfoGet(ls_File); FSetValue(Grid_FileProperty, Fci_PROPERTY_COMMENTS, l_VerInfo.Comments); // コメント FSetValue(Grid_FileProperty, Fci_PROPERTY_COMPANYNAME, l_VerInfo.CompanyName); // 会社名 FSetValue(Grid_FileProperty, Fci_PROPERTY_FILEDESCRIPTION, l_VerInfo.FileDescription); // 説明 FSetValue(Grid_FileProperty, Fci_PROPERTY_FILEVERSION, l_VerInfo.FileVersion); // ファイルバージョン FSetValue(Grid_FileProperty, Fci_PROPERTY_INTERNALNAME, l_VerInfo.InternalName); // 内部名 FSetValue(Grid_FileProperty, Fci_PROPERTY_LEGALCOPYRIGHT, l_VerInfo.LegalCopyright); // 著作権 FSetValue(Grid_FileProperty, Fci_PROPERTY_LEGALTRADEMARKS, l_VerInfo.LegalTrademarks); // 商標 FSetValue(Grid_FileProperty, Fci_PROPERTY_ORIGINALFILENAME, l_VerInfo.OriginalFilename); // 正式ファイル名 FSetValue(Grid_FileProperty, Fci_PROPERTY_PRODUCTNAME, l_VerInfo.ProductName); // 製品名 FSetValue(Grid_FileProperty, Fci_PROPERTY_PRODUCTVERSION, l_VerInfo.ProductVersion); // 製品バージョン FSetValue(Grid_FileProperty, Fci_PROPERTY_PRIVATEBUILD, l_VerInfo.PrivateBuild); // プライベートビルド情報 FSetValue(Grid_FileProperty, Fci_PROPERTY_SPECIALBUILD, l_VerInfo.SpecialBuild); // スペシャルビルド情報 end; procedure TApp_TOOLWindowStyle.FSetStyleInfo(AInfo: T_WinInfo); procedure _ChkStyle(iStyle: Longint; AddList, AStyleList: TStrings); var li_Comp : Longint; i : Integer; begin for i := 0 to AStyleList.Count-1 do begin li_Comp := GetStyleValue(AStyleList[i]); if (li_Comp = 0) then begin if ((iStyle and 1) = 0) then begin AddList.Add(AStyleList[i]); end; end else if ((iStyle and li_Comp) = li_Comp) then begin AddList.Add(AStyleList[i]); end; end; end; var l_Info : T_WinInfo; begin ListBox_Style.Items.BeginUpdate; try ListBox_Style.Items.Clear; ListBox_Style.Items.Add(Format(#9'%10s GWL_STYLE', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_Style.Lines); ListBox_Style.Items.Add(Format(#9'%10s GWL_EXSTYLE', [Format('0x%x', [l_Info.iExStyle])])); _ChkStyle(l_Info.iExStyle, ListBox_Style.Items, Memo_Style_ExStyle.Lines); if (Action_Style_Button.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s Button', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_Button.Lines); end; if (Action_Style_Edit.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s Edit', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_Edit.Lines); end; if (Action_Style_Static.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s Static', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_Static.Lines); end; if (Action_Style_ComboBox.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s ComboBox', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_ComboBox.Lines); end; if (Action_Style_ListBox.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s ListBox', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_ListBox.Lines); end; if (Action_Style_ScrollBar.Checked) then begin ListBox_Style.Items.Add(Format(#9'%10s ScrollBar', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_ScrollBar.Lines); end; if (Action_Style_TrackBar.Checked) then begin //http://open-shelf.appspot.com/AutoItUDFs3.3.6.1j/html/libfunctions/_GUICtrlSlider_Create.htm ListBox_Style.Items.Add(Format(#9'%10s TrackBar', [Format('0x%x', [l_Info.iStyle])])); _ChkStyle(l_Info.iStyle, ListBox_Style.Items, Memo_Style_TrackBar.Lines); end; finally ListBox_Style.Items.EndUpdate; end; end; procedure TApp_TOOLWindowStyle.FDoAPITest; var i, k : Integer; li_Row : Integer; begin gpcGridBeginUpdate(StringGrid_APITestResult); try StringGrid_APITestResult.RowCount := 2; gpcGridDataClear(StringGrid_APITestResult); li_Row := StringGrid_APITestResult.FixedRows; for i := 0 to CheckListBox_APITestSelect.Items.Count -1 do begin if (CheckListBox_APITestSelect.Checked[i]) then begin if (FAPIValue.Execute(CheckListBox_APITestSelect.Items[i], FhHandle, Point(0, 0)) <> -1) then begin gpcStringGridTextSet(StringGrid_APITestResult, Fci_COL_ELEMENT, li_Row, #1 + FAPIValue.APIName); gpcStringGridTextSet(StringGrid_APITestResult, Fci_COL_RESULT, li_Row, #1 + FAPIValue.Declaration); Inc(li_Row); for k := 0 to FAPIValue.Count -1 do begin if (FAPIValue.ParamCount > k) then begin gpcStringGridTextSet(StringGrid_APITestResult, Fci_COL_ELEMENT, li_Row, FAPIValue.Params[k]); end; if (FAPIValue.ValueCount > k) then begin gpcStringGridTextSet(StringGrid_APITestResult, Fci_COL_RESULT, li_Row, FAPIValue.Values[k]); end; Inc(li_Row); end; end; end; end; finally gpcGridEndUpdate(StringGrid_APITestResult); end; end; procedure TApp_TOOLWindowStyle.PageControl_APITestChange(Sender: TObject); begin if (PageControl_APITest.ActivePage = TabSheet_APITestResult) then begin FDoAPITest; end; end; procedure TApp_TOOLWindowStyle.CheckListBox_APITestSelectClick(Sender: TObject); var li_Index: Integer; begin li_Index := CheckListBox_APITestSelect.ItemIndex; if (gfnbIsInsideRange(li_Index, 0, FAPIValue.Items.Count -1)) then begin FAPIValue.Execute(CheckListBox_APITestSelect.Items[li_Index], 0, Point(0, 0)); RichEdit_APITestSelectHint.Text := Format('%s'#13'%s', [FAPIValue.Declaration, FAPIValue.Description]); end else begin //範囲外 RichEdit_APITestSelectHint.Text := ''; end; end; procedure TApp_TOOLWindowStyle.FSetTitle(AGrid: TStringGrid; iRow: Integer; sTitle: String); begin AGrid.Cells[0, iRow] := sTitle; end; procedure TApp_TOOLWindowStyle.FSetValue(AGrid: TStringGrid; iRow: Integer; sValue: String); begin AGrid.Cells[1, iRow] := sValue; end; procedure TApp_TOOLWindowStyle.Action_Info_GetExecute(Sender: TObject); var l_PInfo : P_WinInfo; begin if (Action_Info_Cash.Checked) // and (FNode.Data <> nil) // and (IsWindow(T_WinInfo(FNode.Data^).hHandle)) or not(IsWindow(T_WinInfo(FNode.Data^).hHandle)) then begin //キャッシュから読み出す。 l_PInfo := @T_WinInfo(FNode.Data^); end else begin //現在の状態を取得(既にウィンドウが存在しない場合もあり) l_PInfo := @T_WinInfo(FNode.Data^); F_GetWinInfo(l_PInfo, FhHandle); end; Label_ExeName.Caption := gfnsExeNameGet(FhHandle); if (PageControl_Info.ActivePage = TabSheet_WinInfo) then begin FSetWindowInfo(l_PInfo^); end else if (PageControl_Info.ActivePage = TabSheet_FileProperty) then begin FSetFileInfo; //(l_PInfo^); end else if (PageControl_Info.ActivePage = TabSheet_Style) then begin FSetStyleInfo(l_PInfo^); end else if (PageControl_Info.ActivePage = TabSheet_APITest) then begin FDoAPITest; end; end; procedure TApp_TOOLWindowStyle.Action_File_ExitExecute(Sender: TObject); //終了 begin Hide; Close; end; procedure TApp_TOOLWindowStyle.Action_File_OpenExeFolderExecute(Sender: TObject); //実行ファイルのフォルダを開く begin if (FNode <> nil) then begin if (FileExists(Label_ExeName.Caption)) then begin gpcExploreOpen(Label_ExeName.Caption); end; end; end; procedure TApp_TOOLWindowStyle.Action_Info_ReloadExecute(Sender: TObject); function _WinInfoAdd(Node: TTreeNode; hHandle: HWND; AForm: TApp_TOOLWindowStyle): TTreeNode; function _GetParentNode(var Node: TTreeNode; Parent: TTreeNode; hParent: HWND): Boolean; var i : Integer; l_Node : TTreeNode; begin Result := False; for i := Parent.Count-1 downto 0 do begin l_Node := Parent.Item[i]; if (T_WinInfo(l_Node.Data^).hHandle = hParent) then begin Node := l_Node; Result := True; Break; end else begin Result := _GetParentNode(Node, l_Node, hParent); if (Result) then begin Break; end; end; end; end; var l_PInfo : P_WinInfo; lh_Parent : HWND; l_Node : TTreeNode; // l_Rect : TRect; begin l_PInfo := nil; F_GetWinInfo(l_PInfo, hHandle); lh_Parent := gfnhParentWindowGet(hHandle); l_Node := Node; if (Node <> nil) then begin if (lh_Parent <> 0) then begin _GetParentNode(l_Node, Node, lh_Parent); end; end; //myDebug.gpcDebug(Format('%.6s %s (%d,%d %d-%d) "%s"', [LowerCase(IntToHex(hHandle, 6)), FGetClassName(hHandle), lrc_Rect.Left, lrc_Rect.Top, gfniRectWidth(lrc_Rect), gfniRectHeight(lrc_Rect), FGetWindowText(hHandle)])); Result := AForm.TreeView_Window.Items.AddChildObject(l_Node, F_GetTreeViewCaption(l_PInfo^), l_PInfo); // Application.ProcessMessages; end; function _ChildWindowProc(hHandle: HWND; Form: TApp_TOOLWindowStyle):BOOL; stdcall; //子ウィンドウを列挙する begin _WinInfoAdd(Form.FToplevelNode, hHandle, Form); Result := True; end; function _MainWindowProc(hHandle: HWND; AForm: TApp_TOOLWindowStyle):BOOL; stdcall; //トップレベルウィンドウを列挙する begin if (AForm.Action_Info_Visible.Checked) //可視ウィンドウのみの場合で and (IsWindowVisible(hHandle) = False) //非可視ウィンドウは then begin //除外 //除外 end else begin AForm.FToplevelNode := _WinInfoAdd(nil, hHandle, AForm); AForm.FToplevelNode.Text := AForm.FToplevelNode.Text + ExtractFileName(T_WinInfo(AForm.FToplevelNode.Data^).rFileProperty.sFileName); EnumChildWindows(hHandle, @_ChildWindowProc, LPARAM(AForm)); Application.ProcessMessages; end; Result := True; end; procedure _GridDataClear(AGrid : TStringGrid); var i : Integer; begin with AGrid do begin for i := FixedRows to RowCount-1 do begin Cells[1, i] := ''; end; end; end; begin Self.Enabled := False; try FbThrough := True; Label_ExeName.Caption := ''; //1列目は実は固定セルではないのでgpcGridDataClearではNG _GridDataClear(Grid_WinInfo); _GridDataClear(Grid_FileProperty); ListBox_Style.Items.Clear; gpcTreeViewClear(TreeView_Window); EnumWindows(@_MainWindowProc, LPARAM(Self)); FbThrough := False; finally Self.Enabled := True; end; end; procedure TApp_TOOLWindowStyle.Action_Info_CashExecute(Sender: TObject); //更新時の情報 begin if (Action_Info_Cash.Checked) then begin TreeView_Window.Font.Color := clInfoText; TreeView_Window.Color := clInfoBk; ListBox_Style.Font.Color := clInfoText; ListBox_Style.Color := clInfoBk; end else begin TreeView_Window.Font.Color := clWindowText; TreeView_Window.Color := clWindow; ListBox_Style.Font.Color := clWindowText; ListBox_Style.Color := clWindow; end; ListBox_Style.Refresh; end; procedure TApp_TOOLWindowStyle.Action_Style_ButtonExecute(Sender: TObject); begin // TreeView_WindowChange(Sender, TreeView_Window.Selected); end; procedure TApp_TOOLWindowStyle.FSetCmdEnabled(hWindow: HWND); var lb_IsWindow : Boolean; begin lb_IsWindow := IsWindow(hWindow); Action_CmdSystem_Restore.Enabled := lb_IsWindow and (IsIconic(FhHandle) or IsZoomed(FhHandle)); Action_CmdSystem_Move.Enabled := lb_IsWindow; Action_CmdSystem_Resize.Enabled := lb_IsWindow; Action_CmdSystem_Minimize.Enabled := lb_IsWindow and not(IsIconic(FhHandle)); Action_CmdSystem_Maximize.Enabled := lb_IsWindow and not(IsZoomed(FhHandle)); Action_CmdSystem_Close.Enabled := lb_IsWindow; Action_Cmd_TopMost.Enabled := lb_IsWindow; Action_Cmd_NoTopMost.Enabled := lb_IsWindow; Action_Cmd_Visible.Enabled := lb_IsWindow; Action_Cmd_Enabled.Enabled := lb_IsWindow; Action_Cmd_Visible.Checked := IsWindowVisible(FhHandle); Action_Cmd_Enabled.Checked := IsWindowEnabled(FhHandle); Action_Cmd_BringToFront.Enabled := lb_IsWindow; Action_Cmd_SendtoBack.Enabled := lb_IsWindow; Action_Cmd_SetForeground.Enabled := lb_IsWindow; Action_Cmd_MoveMonitor.Enabled := lb_IsWindow; Action_Cmd_Terminate.Enabled := lb_IsWindow; Action_Capture_Capture.Enabled := lb_IsWindow; Action_File_OpenExeFolder.Enabled := lb_IsWindow; end; procedure TApp_TOOLWindowStyle.WMMouseActivate(var Msg: TWMMOUSEACTIVATE); //OnMouseDownイベントの代わり //ツリービューの右ボタンイベントと左ボタンイベントで同じ処理を行いためにわざわざここでやる var lpt_Pos : TPoint; begin if (FbEvent) then begin Exit; end; FbEvent := True; lpt_Pos := gfnptMousePosGet; lpt_Pos := TreeView_Window.ScreenToClient(lpt_Pos); if (PtInRect(TreeView_Window.ClientRect, lpt_Pos)) {and (gfnbKeyState(VK_RBUTTON))} then begin //マウスボタンを押した直後の処理 TreeView_Window.SetFocus; FNode := TreeView_Window.GetNodeAt(lpt_Pos.X, lpt_Pos.Y); if (FNode <> nil) then begin TreeView_Window.Select(FNode); TreeView_WindowChange(nil, FNode); end; end; Msg.Result := MA_ACTIVATE; FbEvent := False; end; procedure TApp_TOOLWindowStyle.TabSheet_APITestResultResize(Sender: TObject); begin with StringGrid_APITestResult do begin ColWidths[Fci_COL_RESULT] := ClientWidth - ColWidths[Fci_COL_ELEMENT] - (GridLineWidth * ColCount); end; end; procedure TApp_TOOLWindowStyle.TabSheet_CaptureShow(Sender: TObject); begin Action_Capture_CaptureWindowExecute(Sender); end; procedure TApp_TOOLWindowStyle.TabSheet_WinInfoResize(Sender: TObject); begin Grid_WinInfo.ColWidths[1] := Grid_WinInfo.ClientWidth - Grid_WinInfo.ColWidths[0] - (Grid_WinInfo.GridLineWidth * 2); Grid_FileProperty.ColWidths[1] := Grid_FileProperty.ClientWidth - Grid_FileProperty.ColWidths[0] - (Grid_FileProperty.GridLineWidth * 2); end; procedure TApp_TOOLWindowStyle.TreeView_WindowChange(Sender: TObject; Node: TTreeNode); //ツリービューをクリックした var // l_Bounds : TMyBounds; // l_Rect : TRect; l_PInfo : P_WinInfo; ls_ExeName : String; begin if (FbThrough) or (Tag = 0) or (Application.Terminated) or (Node = nil) then begin Exit; end; l_PInfo := @T_WinInfo(Node.Data^); FhHandle := l_PInfo^.hHandle; FSetCmdEnabled(FhHandle); FNode := Node; if not(Action_Info_Cash.Checked) and (IsWindow(FhHandle)) then begin //現在の情報を表示 F_GetWinInfo(l_PInfo, FhHandle); end else begin //取得時の情報を表示 end; if (Node.Level = 0) then begin ls_ExeName := ExtractFileName(l_PInfo^.rFileProperty.sFileName); end else begin ls_ExeName := ''; end; FNode.Text := F_GetTreeViewCaption(l_PInfo^, ls_ExeName); Action_Capture_Capture.Enabled := (l_PInfo^.szWindowSize.Width > 0) and (l_PInfo^.szWindowSize.Height > 0); { if (PageControl1.ActivePage = TabSheet_Capture) then begin Action_Capture_CaptureWindowExecute(nil); end; } StatusBar1.SimpleText := ''; Action_Info_GetExecute(nil); end; //ウィンドウ一覧の描画 procedure TApp_TOOLWindowStyle.TreeView_WindowCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); begin //非表示ウィンドウを色分け if not(T_WinInfo(Node.Data^).bVisible) then begin if (State = []) then begin TreeView_Window.Canvas.Font.Color := clGrayText; end; end; if (Node.Selected) then begin TreeView_Window.Canvas.Brush.Color := clHotlight; TreeView_Window.Canvas.Font.Color := clHighlightText; end; if not(Action_Info_Cash.Checked) and not(IsWindow(T_WinInfo(Node.Data^).hHandle)) then begin TreeView_Window.Canvas.Font.Style := [fsStrikeOut]; end; end; procedure TApp_TOOLWindowStyle.ListBox_StyleClick(Sender: TObject); const lci_POS_DESCRIPTION = 35; const lciSTART_STYLENAME = 12; lciSTART_STYLETEXT = 35; var ls_Str : String; ls_Hint : String; li_Pos : Integer; begin if (ListBox_Style.ItemIndex < 0) then begin TabSheet_Style.Hint := ''; end else begin ls_Str := ListBox_Style.Items[ListBox_Style.ItemIndex]; if (ls_Str[1] <> #9) //Length(ls_Str) > lci_POS_DESCRIPTION) then begin ls_Hint := Format('%s %s', [ Trim(Copy(ls_Str, lciSTART_STYLENAME, lciSTART_STYLETEXT - lciSTART_STYLENAME)), Copy(ls_Str, lciSTART_STYLETEXT, MaxInt) ]); //ヒントを下部のヒントメッセージ欄に表示させる li_Pos := Pos('。', ls_Hint); if (li_Pos > 0) then begin ls_Hint := Format('%s'#13'%s', [ Copy(ls_Hint, 1, li_Pos), Copy(ls_Hint, li_Pos +1, MAXINT) ]); end end else begin ls_Hint := ''; end; end; RichEdit_Hint.Text := ls_Hint; end; procedure TApp_TOOLWindowStyle.ListBox_StyleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Index : Integer; begin if not(Sender is TListBox) then begin Exit; end; if (Button = mbRight) then begin li_Index := gfniListBoxMouseOnIndex(ListBox_Style); if (li_Index >= 0) then begin ListBox_Style.ItemIndex := li_Index; ListBox_StyleClick(nil); end; end; end; procedure TApp_TOOLWindowStyle.ListBox_StyleDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); //スタイルリストの描画 var lrc_Rect : TRect; begin with ListBox_Style.Canvas do begin //タイトルを色分け if (ListBox_Style.Items[Index] <> '') and (ListBox_Style.Items[Index][1] = #9) then begin Font.Color := clBtnText; Brush.Color := clBtnFace; end; FillRect(Rect); lrc_Rect := Rect; Inc(lrc_Rect.Left, Fci_MARGIN); DrawText(Handle, PChar(ListBox_Style.Items[Index]), -1, lrc_Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); //タイトルの上に線を引く if (Index > 0) and (ListBox_Style.Items[Index] <> '') and (ListBox_Style.Items[Index][1] = #9) then begin MoveTo(Rect.Left, Rect.Top); LineTo(Rect.Right, Rect.Top) end; end; end; procedure TApp_TOOLWindowStyle.TreeView_WindowDblClick(Sender: TObject); begin if (TreeView_Window.Selected.Expanded) then begin TreeView_Window.Selected.Expand(True); end else begin TreeView_Window.Selected.Collapse(True); end; end; procedure TApp_TOOLWindowStyle.PopupMenu_CmdPopup(Sender: TObject); var lb_Window : Boolean; begin lb_Window := IsWindow(FhHandle); Action_CmdSystem.Enabled := lb_Window; Action_Cmd.Enabled := lb_Window; Action_Region.Enabled := lb_Window; Action_Style_Change.Enabled := (TreeView_Window.Selected <> nil); FSetCmdEnabled(FhHandle); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_MoveExecute(Sender: TObject); //コマンド - 移動 var l_InputNum : TTool_InputNum; lrc_Rect, lrc_Parent : TRect; begin if (FCheckHungup) then begin Exit; end; l_InputNum := TTool_InputNum.Create(Self); try lrc_Rect := gfnrcWindowRectGet(FhHandle); lrc_Parent := gfnrcWindowRectGet(gfnhParentWindowGet(FhHandle)); l_InputNum.Labels[1] := 'Left'; l_InputNum.Labels[2] := 'Top'; l_InputNum.Values[1] := lrc_Rect.Left - lrc_Parent.Left; l_InputNum.Values[2] := lrc_Rect.Top - lrc_Parent.Top; if (l_InputNum.ShowModal = mrOK) then begin SetWindowPos(FhHandle, 0, l_InputNum.Values[1], l_InputNum.Values[2], 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE); end; finally l_InputNum.Release; end; TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_ResizeExecute(Sender: TObject); //コマンド - サイズ変更 var l_InputNum : TTool_InputNum; lrc_Rect : TRect; begin if (FCheckHungup) then begin Exit; end; l_InputNum := TTool_InputNum.Create(Self); try lrc_Rect := gfnrcWindowRectGet(FhHandle); l_InputNum.Labels[1] := '幅'; l_InputNum.Labels[2] := '高さ'; l_InputNum.Values[1] := gfniRectWidth (lrc_Rect); l_InputNum.Values[2] := gfniRectHeight(lrc_Rect); if (l_InputNum.ShowModal = mrOK) then begin SetWindowPos(FhHandle, 0, 0, 0, l_InputNum.Values[1], l_InputNum.Values[2], SWP_NOZORDER or SWP_NOMOVE or SWP_NOACTIVATE); end; finally l_InputNum.Release; end; TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_RestoreExecute(Sender: TObject); //コマンド - 元に戻す begin gfniSendMessageTimeout(FhHandle, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0, 500); TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_MinimizeExecute(Sender: TObject); //コマンド - 最小化 begin gfniSendMessageTimeout(FhHandle, WM_SYSCOMMAND, WPARAM(SC_MINIMIZE and $FFF0), 0, 500); TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_MaximizeExecute(Sender: TObject); //コマンド - 最大化 begin gfniSendMessageTimeout(FhHandle, WM_SYSCOMMAND, WPARAM(SC_MAXIMIZE and $FFF0), 0, 500); TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_CmdSystem_CloseExecute(Sender: TObject); //コマンド - 閉じる begin if (gfniMessageBoxYesNo('選択ウィンドウを閉じます(あるいは強制終了させます)'#13'よろしいですか') = ID_YES) then begin gfniSendMessageTimeout(FhHandle, WM_SYSCOMMAND, WPARAM(SC_CLOSE and $FFF0), 0, 500); if not(IsWindow(FhHandle)) then begin //ツリービューからウィンドウを削除 FNode.Delete; end; TreeView_WindowChange(nil, FNode); end; end; procedure TApp_TOOLWindowStyle.Action_Region_DefaultRegionExecute(Sender: TObject); //リージョン - デフォルトリージョンをセット begin SetWindowRgn(FhHandle, 0, True); end; procedure TApp_TOOLWindowStyle.Action_Region_WindowRectExecute(Sender: TObject); //リージョン - ウィンドウのRECTをセット var l_Rect : TRect; l_Region : HRGN; begin l_Rect := gfnrcWindowRectGet(FhHandle); l_Region := CreateRectRgn(0, 0, gfniRectWidth(l_Rect), gfniRectHeight(l_Rect)); SetWindowRgn(FhHandle, l_Region, True); end; procedure TApp_TOOLWindowStyle.Action_Region_GetRgnBoxExecute(Sender: TObject); //リージョン - リージョンのRECTを調べる begin // end; function TApp_TOOLWindowStyle.FCheckHungup : Boolean; begin Result := gfnbIsHungup(FhHandle); if (Result) then begin if (gfnbKeyState(VK_CONTROL)) then begin Result := (gfniMessageBoxYesNo('選択ウィンドウはフリーズしているようですが操作を実行しますか'#13'[はい]で実行した場合このプログラムがつられてフリーズすることもあります') = ID_NO); end else begin gpcShowMessage('選択ウィンドウはフリーズしているようです'); end; end; end; procedure TApp_TOOLWindowStyle.Action_Cmd_VisibleExecute(Sender: TObject); //コマンド - Vislbe begin if (FCheckHungup) then begin Exit; end; if not(Action_Cmd_Visible.Checked) then begin ShowWindow(FhHandle, SW_SHOW); end else begin ShowWindow(FhHandle, SW_HIDE); end; TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_Cmd_EnabledExecute(Sender: TObject); //コマンド - Enabled begin if (FCheckHungup) then begin Exit; end; EnableWindow(FhHandle, Action_Cmd_Enabled.Checked); TreeView_WindowChange(nil, FNode); end; procedure TApp_TOOLWindowStyle.Action_Cmd_BringToFrontExecute(Sender: TObject); //コマンド - 前面に移動 begin if (FCheckHungup) then begin Exit; end; SetWindowPos(FhHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE{ or SWP_NOACTIVATE}); end; procedure TApp_TOOLWindowStyle.Action_Cmd_SendToBackExecute(Sender: TObject); //コマンド - 背面に移動 begin if (FCheckHungup) then begin Exit; end; SetWindowPos(FhHandle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; procedure TApp_TOOLWindowStyle.Action_Cmd_SetForegroundExecute(Sender: TObject); //コマンド - SetForegroundWindow begin if (FCheckHungup) then begin Exit; end; SetForegroundWindow(FhHandle); end; procedure TApp_TOOLWindowStyle.Action_Cmd_TerminateExecute(Sender: TObject); //コマンド - 強制終了 var lh_Process : THandle; begin if (gfniMessageBoxYesNo('選択ウィンドウのプログラムを強制終了させます'#13'よろしいですか') = ID_YES) then begin lh_Process := gfnhWindowProcessGet(FhHandle); try TerminateProcess(lh_Process, 0); finally CloseHandle(lh_Process); end; end; end; procedure TApp_TOOLWindowStyle.Action_Cmd_TopMostExecute(Sender: TObject); //コマンド - 常に前面に表示 begin if (FCheckHungup) then begin Exit; end; SetWindowPos(FhHandle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; procedure TApp_TOOLWindowStyle.Action_Cmd_NoTopMostExecute(Sender: TObject); //コマンド - 常に前面に表示を解除 begin if (FCheckHungup) then begin Exit; end; SetWindowPos(FhHandle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); end; procedure TApp_TOOLWindowStyle.Action_Cmd_MoveMonitorExecute(Sender: TObject); //モニター間移動 var li_Index : Integer; // l_WindowPos : TWindowPos; begin if (FCheckHungup) then begin Exit; end; li_Index := gfniNumLoop(gfniMonitorIndexGet(FhHandle) +1, 0, Screen.MonitorCount -1); SetWindowPos(FhHandle, 0, Screen.Monitors[li_Index].Left, Screen.Monitors[li_Index].Top, 0, 0, SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE); //myDebug.gpcDebug([FhHandle, li_Index, Screen.Monitors[li_Index].Left, Screen.Monitors[li_Index].Top]); { FillChar(l_WindowPos, SizeOf(l_WindowPos), 0); l_WindowPos.hwnd := FhHandle; l_WindowPos.x := Screen.Monitors[li_Index].Left; l_WindowPos.y := Screen.Monitors[li_Index].Top; l_WindowPos.flags := SWP_NOZORDER or SWP_NOSIZE or SWP_NOACTIVATE; if (gfniSendMessageTimeout(FhHandle, WM_WINDOWPOSCHANGING, 0, LPARAM(@l_WindowPos), 5000) = 0) then begin gpcShowMessage('操作しようとしているウィンドウがハングアップしているようです'); end; } end; procedure TApp_TOOLWindowStyle.actNop(Sender: TObject); begin // end; procedure TApp_TOOLWindowStyle.Action_Style_ChangeExecute(Sender: TObject); begin if not(IsWindow(FhHandle)) then begin Exit; end; if (TreeView_Window.Selected <> nil) then begin gpcCreateSetStyleForm; with TOOL_WindowStyle do begin TgtStyle := GetWindowLong(FhHandle, GWL_STYLE); TgtExStyle := GetWindowLong(FhHandle, GWL_EXSTYLE); ShowModal; end; end; end; procedure TApp_TOOLWindowStyle.Action_Capture_CaptureWindowExecute(Sender: TObject); //ウィンドウキャプチャ procedure _ClearImage; begin Image_Bitmap.Picture.Bitmap.Assign(nil); Grid_Bitmap.Visible := False; Label_BitmapEmpty.Visible := True; end; var lh_DC : HDC; l_Rect : TRect; li_Width : Integer; li_Height : Integer; l_Region : HRGN; begin if not(IsWindow(FhHandle)) then begin Label_BitmapEmpty.Caption := 'ウィンドウハンドルが無効です'; _ClearImage; Exit; end; l_Rect := gfnrcWindowRectGet(FhHandle); li_Width := gfniRectWidth (l_Rect); li_Height := gfniRectHeight(l_Rect); if (li_Width <= 0) or (li_Height <= 0) then begin Label_BitmapEmpty.Caption := 'ウィンドウのサイズが0です'; _ClearImage; Exit; end; Image_Bitmap.Picture.Bitmap.Width := li_Width; Image_Bitmap.Picture.Bitmap.Height := li_Height; if (gfnbIsPrintWindowEnabled) and (GetAncestor(FhHandle, GA_ROOT) <> FindWindow('Progman', 'Program Manager')) then begin //PrintWindow APIが使えてデスクトップ以外。 //デスクトップのキャプチャは他のアプリが非表示になったあと戻るのだけれども //画面の更新処理がおかしくなるのでNG。 Image_Bitmap.Picture.Bitmap.Canvas.Lock; try PrintWindow(FhHandle, Image_Bitmap.Picture.Bitmap.Canvas.Handle, 0); finally Image_Bitmap.Picture.Bitmap.Canvas.Unlock; end; end else begin //XP未満＆デスクトップ。 l_Region := CreateRectRgn(0,0,0,0); //ウィンドウリージョン取得 {li_RegionCode :=} GetWindowRgn(FhHandle, l_Region); lh_DC := GetDCEx(FhHandle, l_Region, DCX_WINDOW); try if (lh_DC <> 0) then begin BitBlt( Image_Bitmap.Picture.Bitmap.Canvas.Handle, 0, 0, Image_Bitmap.Picture.Bitmap.Width, Image_Bitmap.Picture.Bitmap.Height, lh_DC, 0, 0, SRCCOPY or CAPTUREBLT ); end; finally ReleaseDC(FhHandle, lh_DC); end; end; Action_Capture_Zoom100Execute(nil); Label_BitmapEmpty.Visible := False; Grid_Bitmap.Visible := True; TabSheet_Capture.Visible := True; PageControl_Info.ActivePage := TabSheet_Capture; end; procedure TApp_TOOLWindowStyle.Action_Capture_CaptureExecute(Sender: TObject); function _IsOSUpperXP: Boolean; {2010-12-19: OSがXP以上であればTrueを返す。 } var l_Info: TOSVersionInfo; begin Result := False; FillChar(l_Info, SizeOf(l_Info), 0); l_Info.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);; if (GetVersionEx(l_Info)) then begin if (l_Info.dwMajorVersion > 5) then begin Result := True; end else if (l_Info.dwMajorVersion = 5) and (l_Info.dwMinorVersion >= 1) then begin Result := True; end; end; end; //ウィンドウキャプチャ var lh_DC : HDC; l_Bitmap : TBitmap; lrc_Rect : TRect; // lb_Ctrl : Boolean; // ls_File : String; lrg_Region : HRGN; // li_RegionCode : Integer; // lh_Process : THandle; // lh_Window : HWND; begin // if (IsWindow(FhHandle)) then begin l_Bitmap := nil; try l_Bitmap := TBitmap.Create; //未使用 // lb_Ctrl := gfnbKeyState(VK_CONTROL); lrc_Rect := gfnrcWindowRectGet(FhHandle); l_Bitmap.Width := gfniRectWidth (lrc_Rect); l_Bitmap.Height := gfniRectHeight(lrc_Rect); if (_IsOSUpperXP) and (GetAncestor(FhHandle, GA_ROOT) <> FindWindow('Progman', 'Program Manager')) then begin //XP以上かつデスクトップ以外。 //デスクトップのキャプチャは他のアプリが非表示になったあと戻るのだけれども //画面の更新処理がおかしくなるのでNG。 l_Bitmap.Canvas.Lock; try PrintWindow(FhHandle, l_Bitmap.Canvas.Handle, 0); finally l_Bitmap.Canvas.Unlock; end; end else begin //XP未満&デスクトップ。 lrg_Region := CreateRectRgn(0,0,0,0); //ウィンドウリージョン取得 {li_RegionCode :=} GetWindowRgn(FhHandle, lrg_Region); lh_DC := GetDCEx(FhHandle, lrg_Region, DCX_WINDOW); try if (lh_DC <> 0) then begin BitBlt(l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width, l_Bitmap.Height, lh_DC, 0, 0, SRCCOPY or CAPTUREBLT); end; finally ReleaseDC(FhHandle, lh_DC); end; end; G_CreateImageForm; G_SetImage(l_Bitmap); { Clipboard.Assign(l_Bitmap); if (lb_Ctrl) then begin ls_File := gfnsFileExtChange(gfnsExeNameGet, '.bmp'); l_Bitmap.SaveToFile(ls_File); // gpcExecute(ls_File); lh_Process := gfnhExecute(Format('"%s"', [ls_File])); try WaitForInputIdle(lh_Process, 3000); lh_Window := gfnhProcessToWindow(lh_Process); if (IsWindow(lh_Window)) then begin SetForegroundWindow(lh_Window); end; finally CloseHandle(lh_Process); end; end; } finally l_Bitmap.Free; end; Beep; end; end; //------------------------------------------------------------------------------ //IniFile const Fci_FIND_TEXTINDEX_CLASSNAME = 0; Fci_FIND_TEXTINDEX_WINDOWTEXT = 1; Fci_FIND_TEXTINDEX_EXENAME = 2; const lcsSECT_BOUNDS = 'Bounds'; lcsKEY_BOUNDS_WINDOWLIST = 'WindowList'; lcsKEY_WIDTH_WINDOWINFO_TITLE = 'WindowInfo'; lcsKEY_WIDTH_PROPERTY_TITLE = 'FileProperty'; lcsKEY_WIDTH_APITEST_PARAM = 'APITestParam'; lcsKEY_HEIGHT_APITESTSEL_HINT = 'SelectHint'; lcsKEY_HEIGHT_APITESTRET_HINT = 'ResultHint'; lcsSECT_STYLE = 'Style'; lcsKEY_STYLE_BUTTON = 'Button'; lcsKEY_STYLE_EDIT = 'Edit'; lcsKEY_STYLE_STATIC = 'Static'; lcsKEY_STYLE_COMBOBOX = 'ComboBox'; lcsKEY_STYLE_LISTBOX = 'ListBox'; lcsKEY_STYLE_SCROLLBAR = 'ScrollBar'; lcsKEY_STYLE_TRACKBAR = 'TrackBar'; lcsSECT_OPT = 'Option'; lcsKEY_OPT_VISIBLE = 'Visible'; lcsKEY_OPT_CASH = 'Cash'; lcsSECT_FIND = 'Find'; lcsKEY_FIND_TEXTINDEX = 'FindText'; // lcsSECT_FIND_TEXT = 'FindText'; function TApp_TOOLWindowStyle.FLoadIni: Boolean; var l_IniFile : TMyIniFile; begin Result := not(gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])); if not(Result) then begin Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try if not(gfnbKeyState(VK_SHIFT)) then begin SetMonitorBoundsRect(Self); TreeView_Window.Width := gfniNumLimit(ReadInteger(lcsSECT_BOUNDS, lcsKEY_BOUNDS_WINDOWLIST, TreeView_Window.Width), 50, ClientWidth - 100); end; //Width Grid_WinInfo.ColWidths[0] := ReadInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_WINDOWINFO_TITLE, Grid_WinInfo.ColWidths[0]); Grid_FileProperty.ColWidths[0] := ReadInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_PROPERTY_TITLE, Grid_FileProperty.ColWidths[0]); StringGrid_APITestResult.ColWidths[0] := ReadInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_APITEST_PARAM, StringGrid_APITestResult.ColWidths[0]); //Height RichEdit_APITestSelectHint.Height := ReadInteger(lcsSECT_BOUNDS, lcsKEY_HEIGHT_APITESTSEL_HINT, RichEdit_APITestSelectHint.Height); //[Style] Action_Style_Button.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_BUTTON, Action_Style_Button.Checked); Action_Style_Edit.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_EDIT, Action_Style_Edit.Checked); Action_Style_Static.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_STATIC, Action_Style_Static.Checked); Action_Style_ComboBox.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_COMBOBOX, Action_Style_ComboBox.Checked); Action_Style_ListBox.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_LISTBOX, Action_Style_ListBox.Checked); Action_Style_ScrollBar.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_SCROLLBAR, Action_Style_ScrollBar.Checked); Action_Style_TrackBar.Checked := ReadBool(lcsSECT_STYLE, lcsKEY_STYLE_TRACKBAR, Action_Style_TrackBar.Checked); //[Opt] Action_Info_Visible.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_VISIBLE, Action_Info_Visible.Checked); Action_Info_Cash.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPT_CASH, Action_Info_Cash.Checked); Action_Info_CashExecute(nil); //[Find] case ReadInteger(lcsSECT_FIND, lcsKEY_FIND_TEXTINDEX, Fci_FIND_TEXTINDEX_CLASSNAME) of Fci_FIND_TEXTINDEX_WINDOWTEXT :begin Action_Find_WindowText.Checked := True; end; Fci_FIND_TEXTINDEX_EXENAME :begin Action_Find_ExeName.Checked := True; end; else begin Action_Find_ClassName.Checked := True; end; end; gpcFindIniLoad(l_IniFile, ComboBox_Find_Text.Items); finally Free; end; end; end; //設定保存 procedure TApp_TOOLWindowStyle.FSaveIni; var l_IniFile : TMyIniFile; li_Index : Integer; begin if (gfnbKeyStateAnd([VK_SHIFT, VK_CONTROL])) then begin Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try if not(gfnbKeyState(VK_SHIFT)) then begin WriteBoundsRect(Self); WriteInteger(lcsSECT_BOUNDS, lcsKEY_BOUNDS_WINDOWLIST, TreeView_Window.Width); end; //Width WriteInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_WINDOWINFO_TITLE, Grid_WinInfo.ColWidths[0]); WriteInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_PROPERTY_TITLE, Grid_FileProperty.ColWidths[0]); WriteInteger(lcsSECT_BOUNDS, lcsKEY_WIDTH_APITEST_PARAM, StringGrid_APITestResult.ColWidths[0]); //Height WriteInteger(lcsSECT_BOUNDS, lcsKEY_HEIGHT_APITESTSEL_HINT, RichEdit_APITestSelectHint.Height); //[Style] WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_BUTTON, Action_Style_Button.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_EDIT, Action_Style_Edit.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_STATIC, Action_Style_Static.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_COMBOBOX, Action_Style_ComboBox.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_LISTBOX, Action_Style_ListBox.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_SCROLLBAR, Action_Style_ScrollBar.Checked); WriteBool(lcsSECT_STYLE, lcsKEY_STYLE_TRACKBAR, Action_Style_TrackBar.Checked); //[Option] WriteBool(lcsSECT_OPT, lcsKEY_OPT_VISIBLE, Action_Info_Visible.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPT_CASH, Action_Info_Cash.Checked); //[Find] if (Action_Find_WindowText.Checked) then begin li_Index := Fci_FIND_TEXTINDEX_WINDOWTEXT; end else if (Action_Find_ExeName.Checked) then begin li_Index := Fci_FIND_TEXTINDEX_EXENAME; end else // if (Action_Find_ClassName.Checked) begin li_Index := Fci_FIND_TEXTINDEX_CLASSNAME; end; WriteInteger(lcsSECT_FIND, lcsKEY_FIND_TEXTINDEX, li_Index); gpcFindIniSave(l_IniFile, ComboBox_Find_Text.Items); finally Free; end; end; end; //--- 検索 --------------------------------------------------------------------- procedure TApp_TOOLWindowStyle.Action_Find_TextDownExecute(Sender: TObject); //テキスト検索 function _CheckText(sFindText, sTgtText : String) : Boolean; begin sTgtText := UpperCase(sTgtText); Result := (sFindText = sTgtText) or (Pos(sFindText, sTgtText) > 0) ; end; var i : Integer; li_Start : Integer; li_End : Integer; li_Inc : Integer; ls_Src : String; l_Find : TStrings; l_Node : TTreeNode; l_Info : T_WinInfo; begin if (gfnsFindTrim(ComboBox_Find_Text.Text) = '') then begin Beep; Exit; end; if (Sender = Action_Find_TextDown) then begin if (TreeView_Window.Selected = nil) then begin li_Start := 0; end else begin li_Start := TreeView_Window.Selected.AbsoluteIndex +1; end; li_End := TreeView_Window.Items.Count -1; li_Inc := 1; end else if (Sender = Action_Find_TextUp) then begin if (TreeView_Window.Selected = nil) then begin li_Start := TreeView_Window.Items.Count -1; end else begin li_Start := TreeView_Window.Selected.AbsoluteIndex -1; end; li_End := 0; li_Inc := -1; end else begin Exit; end; l_Find := nil; try l_Find := TStringList.Create; gpcFindDiv(ComboBox_Find_Text.Text, l_Find); gpcFindHistoryAdd(ComboBox_Find_Text.Items, ComboBox_Find_Text.Text); ComboBox_Find_Text.Text := ComboBox_Find_Text.Items[0]; i := li_Start; while ((Sender = Action_Find_TextDown) and gfnbIsInsideRange(i, li_Start, li_End)) or ((Sender = Action_Find_TextUp) and gfnbIsInsideRange(i, li_End, li_Start)) do begin l_Node := TreeView_Window.Items[i]; l_Info := T_WinInfo(l_Node.Data^); if (Action_Find_ClassName.Checked) then begin ls_Src := l_Info.sClassName; end else if (Action_Find_WindowText.Checked) then begin ls_Src := l_Info.sWindowText; end else if (Action_Find_ExeName.Checked) and (l_Node.Level = 0) then begin ls_Src := ExtractFileName(l_Info.rFileProperty.sFileName); end else begin Inc(i, li_Inc); Continue; end; // if (_CheckText(ls_FindText, ls_TgtText)) if (gfnbIsFindMatch(gfnsFindConvert(ls_Src), l_Find)) then begin TreeView_Window.Items[i].Selected := True; gpcSetFocus(TreeView_Window); Exit; end; Inc(i, li_Inc); end; finally l_Find.Free; end; Beep; end; //--- ウィンドウハンドル検索 --------------------------------------------------- procedure TApp_TOOLWindowStyle.Action_Find_Handle16Execute(Sender: TObject); //16進で表示 begin if (Action_Find_Handle16.Checked) then begin //10進→16進 //Edit_FindHandle.Text := FGetNum(gfniStrToInt(Edit_FindHandle.Text)); FHandleText := FGetNum(gfniStrToInt(FHandleText)); end else begin //16進→10進 FHandleText := FGetNum(FGetHandle); end; end; procedure TApp_TOOLWindowStyle.Action_Find_HandleExecute(Sender: TObject); //数値検索(ウィンドウハンドル、PID) const lci_FINDNUM_HANDLE = 0; lci_FINDNUM_PID = 1; var i : Integer; l_Info : P_WinInfo; li_Handle : DWORD; lh_WinHandle : DWORD; // ls_Str : String; li_PID : DWORD; li_FindPID : DWORD; lh_Toplevel : HWND; lb_Visible : Boolean; ls_Msg : String; begin case ComboBox_FindNum.ItemIndex of lci_FINDNUM_HANDLE //ウィンドウハンドルの検索。 :begin lh_WinHandle := FGetHandle; if (IsWindow(lh_WinHandle)) then begin for i := 0 to TreeView_Window.Items.Count-1 do begin l_Info := @T_WinInfo(TreeView_Window.Items[i].Data^); li_Handle := l_Info.hHandle; { ls_Str := TreeView_Window.Items[i].Text; li_Handle := gfniStrToInt('$' + Copy(ls_Str, 1, Pos(' ', ls_Str)-1)); } if (lh_WinHandle = li_Handle) then begin TreeView_Window.Items[i].Selected := True; gpcSetFocus(TreeView_Window); Exit; end; end; ls_Msg := 'ウィンドウハンドルは有効ですがリストに存在しません'#13; lh_Toplevel := gfnhToplevelWindowGet(lh_WinHandle); lb_Visible := IsWindowVisible(lh_Toplevel); if (Action_Info_Visible.Checked) and not(lb_Visible) then begin //可視トップレベルウィンドウだけで対象ウィンドウのトップレベルが非可視だった ls_Msg := ls_Msg + '「可視トップレベルウィンドウのみリストアップ」する設定になっています'#13'チェックを外せば見つかる可能性があります'; end else begin ls_Msg := ls_Msg + 'リロードすれば見つかる可能性があります'; end; end else begin ls_Msg := 'ウィンドウハンドルが無効です'; end; gpcShowMessage(ls_Msg) end; lci_FINDNUM_PID //PIDの検索。 :begin li_FindPID := FGetHandle; for i := 0 to TreeView_Window.Items.Count-1 do begin l_Info := @T_WinInfo(TreeView_Window.Items[i].Data^); li_PID := l_Info.iProcessID; if (li_FindPID = li_PID) then begin TreeView_Window.Items[i].Selected := True; gpcSetFocus(TreeView_Window); Exit; end; end; lh_WinHandle := gfnhPIDToWindow(li_FindPID); if (lh_WinHandle <> 0) then begin ls_Msg := Format('プロセスIDは有効ですがリストに存在しません %d'#13, [li_FindPID]); lh_Toplevel := gfnhToplevelWindowGet(lh_WinHandle); lb_Visible := IsWindowVisible(lh_Toplevel); if (Action_Info_Visible.Checked) and not(lb_Visible) then begin //可視トップレベルウィンドウだけで対象ウィンドウのトップレベルが非可視だった ls_Msg := ls_Msg + '「可視トップレベルウィンドウのみリストアップ」する設定になっています'#13'チェックを外せば見つかる可能性があります'; end else begin ls_Msg := ls_Msg + 'リロードすれば見つかる可能性があります'; end; end else begin ls_Msg := Format('プロセスIDが無効です %d', [li_FindPID]); end; gpcShowMessage(ls_Msg) end; end; end; procedure TApp_TOOLWindowStyle.Grid_Find_HandleDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); const lci_MARGIN = 2; var lrc_Rect : TRect; begin lrc_Rect := Rect; with Grid_Find_Handle.Canvas do begin Font.Assign(Grid_Find_Handle.Font); { if (GetFocus = Grid_Find_Handle.Handle) then begin Brush.Color := clHighlight; Font.Color := clHighlightText; end else } if not(Grid_Find_Handle.Enabled) then begin Brush.Color := Grid_Find_Handle.Color; Font.Color := clGrayText; end else begin Brush.Color := Grid_Find_Handle.Color; Font.Color := Grid_Find_Handle.Font.Color; end; FillRect(lrc_Rect); Dec(lrc_Rect.Right, lci_MARGIN); DrawText(Handle, PChar(FGetFindHandleText), -1, lrc_Rect, DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or DT_RIGHT); end; end; function TApp_TOOLWindowStyle.FIsNum(iCode : Word) : Boolean; begin Result := False; case iCode of VK_0..VK_9 :begin //数値。許可 Result := True; end; Ord('A')..Ord('F'), //敢えてVK_AやVK_Fにはしない。 Ord('a')..Ord('f') :begin //16進値表示なら許可 Result := Action_Find_Handle16.Checked; end; Ord(',') :begin //3桁の区切り //10進値表示なら許可。 Result := not(Action_Find_Handle16.Checked); end; end; end; function TApp_TOOLWindowStyle.FGetNum(iNum : Int64) : String; begin iNum := gfniNumLimit(iNum, 0, MAXLONGINT); if (Action_Find_Handle16.Checked) then begin Result := LowerCase(Format('%x', [iNum])); end else begin Result := Format('%d', [iNum]); end; end; function TApp_TOOLWindowStyle.FGetNum(sNum : String) : DWORD; var i : Integer; li_Pos : Integer; begin if (Action_Find_Handle16.Checked) then begin li_Pos := Pos('x', LowerCase(sNum)); if (li_Pos > 0) then begin sNum := LowerCase(Copy(sNum, li_Pos +1, MAXINT)); end; for i := 1 to Length(sNum) do begin if not(Pos(sNum[i], '01234567890abcdef') = 0) then begin Break; end; end; if (sNum <> '') then begin sNum := '$' + sNum; end; end; if (sNum = '') then begin Result := 0; end else begin Result := gfniNumLimit(gfniStrToInt(sNum), 0, MAXINT); end; end; function TApp_TOOLWindowStyle.FGetHandle : DWORD; begin Result := FGetNum(FHandleText); end; function TApp_TOOLWindowStyle.FGetFindHandleText : String; begin Result := Grid_Find_Handle.Cells[0, 0]; end; procedure TApp_TOOLWindowStyle.FSetFindHandleText(sValue : String); begin Grid_Find_Handle.Cells[0, 0] := sValue; end; function TApp_TOOLWindowStyle.FIncNum(sNum : String; iInc : Integer = 0) : String; begin Result := FGetNum(Int64(FGetNum(sNum)) + iInc); end; procedure TApp_TOOLWindowStyle.Grid_Find_HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //アドレス入力ボックス procedure _AddrStrAdd(var iKey : Word); const lci_HANDLEWIDTH = 16; var ls_Num : String; li_Len : Integer; begin try //myDebug.gpcDebug(Edit_FindHandle.Text, Char(iKey)); ls_Num := gfnsStrHeadTrim(FHandleText, '0'); li_Len := gfniMax([Length(ls_Num), 1]); if (li_Len >= lci_HANDLEWIDTH) then begin Beep; Exit; end else begin FHandleText := FGetNum(FGetNum(ls_Num + Char(iKey))); end; finally iKey := 0; end; end; begin if (ssCtrl in Shift) then begin Exit; end; case Key of VK_0..VK_9, VK_NUMPAD0..VK_NUMPAD9 :begin //数値。許可。 _AddrStrAdd(Key); end; VK_A..VK_F :begin //A-F if (Action_Find_Handle16.Checked) then begin //16進表示。 _AddrStrAdd(Key); end else begin //10進表示なら不許可。 Beep; Key := 0; end; end; Ord(',') :begin //3桁の区切り if (Action_Find_Handle16.Checked) then begin //16進表示なら不許可。 Beep; Key := 0; end else begin //10進表示なら許可。 _AddrStrAdd(Key); end; end; VK_UP :begin //数値アップ Spin_Find_HandleUpClick(Spin_Find_Handle); Key := 0; end; VK_DOWN :begin //数値ダウン Spin_Find_HandleDownClick(Spin_Find_Handle); Key := 0; end; VK_BACK :begin //後退 Action_Edit_FindHandleBackExecute(nil); Key := 0 end; VK_ESCAPE, VK_DELETE :begin //消去 Action_Edit_FindHandleClearExecute(nil); Key := 0; end; VK_RETURN, VK_SHIFT, VK_TAB, VK_LEFT, VK_RIGHT, VK_HOME, VK_END :begin //許可 end; else begin Beep; Key := 0; end; end; end; procedure TApp_TOOLWindowStyle.Grid_Find_HandleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin // if (ssCtrl in Shift) then begin case Key of VK_C :begin //コピー Action_Edit_FindHandleCopyExecute(nil); end; VK_V :begin //貼り付け Action_Edit_FindHandlePasteExecute(nil); end; end; //デフォルト処理はすべて無効にする Key := 0; Exit; end; case Key of VK_RETURN :begin //検索実行 Action_Find_HandleExecute(nil); Key := 0; end; end; Key := 0; end; procedure TApp_TOOLWindowStyle.Spin_Find_HandleDownClick(Sender: TObject); var li_UpDown : Integer; begin if (FbChanging) then begin //無限ループを防止 Exit; end; FbChanging := True; li_UpDown := -1; if (gfnbKeyState(VK_SHIFT)) then begin if (Action_Find_Handle16.Checked) then begin li_UpDown := li_UpDown * 16; end else begin li_UpDown := li_UpDown * 10; end; end; FHandleText := FIncNum(FHandleText, li_UpDown); FbChanging := False; end; procedure TApp_TOOLWindowStyle.Spin_Find_HandleUpClick(Sender: TObject); var li_UpDown : Integer; begin if (FbChanging) then begin //無限ループを防止 Exit; end; FbChanging := True; li_UpDown := +1; if (gfnbKeyState(VK_SHIFT)) then begin if (Action_Find_Handle16.Checked) then begin li_UpDown := li_UpDown * 16; end else begin li_UpDown := li_UpDown * 10; end; end; FHandleText := FIncNum(FHandleText, li_UpDown); FbChanging := False; end; //--- 編集 --------------------------------------------------------------------- //検索欄 procedure TApp_TOOLWindowStyle.PopupMenu_FindHandlePopup(Sender: TObject); begin Action_Edit_FindHandlePaste.Enabled := (FGetNum(Clipboard.AsText) > 0); Action_Edit_FindHandleClear.Enabled := (FGetHandle > 0); Action_Edit_FindHandleBack.Enabled := Action_Edit_FindHandleClear.Enabled; end; procedure TApp_TOOLWindowStyle.Action_Edit_FindHandleCopyExecute(Sender: TObject); //コピー begin Clipboard.AsText := FHandleText; end; procedure TApp_TOOLWindowStyle.Action_Edit_FindHandlePasteExecute(Sender: TObject); //貼り付け var i : Integer; ls_Num : String; begin if (Clipboard.HasFormat(CF_TEXT)) then begin ls_Num := Clipboard.AsText; for i := 1 to Length(ls_Num) do begin if not(FIsNum(Ord(ls_Num[i]))) then begin if (i > 1) then begin ls_Num := Copy(ls_Num, 1, i -1); end else begin ls_Num := ''; end; Break; end; end; if (Action_Find_Handle16.Checked) and (ls_Num <> '') then begin //16進値で表示 ls_Num := '$' + ls_Num; end; FHandleText := FGetNum(gfniStrToInt(ls_Num)); end; end; procedure TApp_TOOLWindowStyle.Action_Edit_FindHandleClearExecute(Sender: TObject); //Clear begin FHandleText := '0'; end; procedure TApp_TOOLWindowStyle.Action_Edit_FindHandleBackExecute(Sender: TObject); //Back var ls_Num : String; begin //Back ls_Num := FHandleText; if (gfniStrToInt(ls_Num) = 0) then begin //0なら何もしない end else begin //表示数値へ変換 ls_Num := Copy(ls_Num, 1, Length(ls_Num) -1); FHandleText := FIncNum(ls_Num); end; end; //------------------------------------------------------------------------------ //ウィンドウ情報 procedure TApp_TOOLWindowStyle.Action_Copy_Num10Execute(Sender: TObject); //数値を10進値でコピー var ls_Handle : String; begin ls_Handle := Format('%d', [FhHandle]); Clipboard.AsText := Format('%d', [FhHandle]); end; procedure TApp_TOOLWindowStyle.Action_Copy_Num16Execute(Sender: TObject); //数値を16進値でコピー var ls_Handle : String; begin ls_Handle := Format('%x', [FhHandle]); Clipboard.AsText := ls_Handle; end; procedure TApp_TOOLWindowStyle.Action_Copy_ValueExecute(Sender: TObject); //ウィンドウ情報をコピー var l_Grid : TStringGrid; ls_Value : String; begin if (Action_Copy_Value.Visible) then begin if (PageControl_Info.ActivePage = TabSheet_WinInfo) then begin l_Grid := Grid_WinInfo; end else if (PageControl_Info.ActivePage = TabSheet_FileProperty) then begin l_Grid := Grid_FileProperty; end else begin Exit; end; if (l_Grid.Row < l_Grid.FixedRows) then begin Exit; end; ls_Value := l_Grid.Cells[1, l_Grid.Row]; Clipboard.AsText := ls_Value; end; end; procedure TApp_TOOLWindowStyle.PopupMenu_CopyValuePopup(Sender: TObject); var li_Col : Integer; li_Row : Integer; begin FCopyPos := Grid_WinInfo.ScreenToClient(gfnptMousePosGet); Grid_WinInfo.MouseToCell(FCopyPos.X, FCopyPos.Y, li_Col, li_Row); case li_Row of Fci_INFO_HANDLE, Fci_INFO_CONTROLID, Fci_INFO_PROCESSID, Fci_INFO_THREADID, Fci_INFO_HINSTANCE :begin if (PageControl_Info.ActivePage = TabSheet_WinInfo) then begin //10進値と16進値でコピー Action_Copy_Value.Visible := False; end else begin Action_Copy_Value.Visible := True; end; end; else begin Action_Copy_Value.Visible := True; end; end; // Action_Copy_Text.Visible := (li_Row > 0); Action_Copy_Num10.Visible := not(Action_Copy_Value.Visible); Action_Copy_Num16.Visible := Action_Copy_Num10.Visible; Action_Copy_Value.Enabled := (FhHandle <> 0); Action_Copy_Num10.Enabled := Action_Copy_Value.Enabled; Action_Copy_Num16.Enabled := Action_Copy_Value.Enabled; end; //ウィンドウツリー procedure TApp_TOOLWindowStyle.Action_Edit_WindowTreeCopyExecute(Sender: TObject); var l_Stream : TStringStream; begin l_Stream := nil; try l_Stream := TStringStream.Create(''); TreeView_Window.SaveToStream(l_Stream); l_Stream.Position := 0; Clipboard.AsText := l_Stream.DataString; finally l_Stream.Free; end; end; //スタイルコピー procedure TApp_TOOLWindowStyle.Action_Edit_StyleCopySelectExecute(Sender: TObject); //選択されているスタイルをコピー var ls_Value : String; begin if (ListBox_Style.ItemIndex >= 0) then begin ls_Value := ListBox_Style.Items[ListBox_Style.ItemIndex]; if (ls_Value[1] <> #9) then begin Clipboard.AsText := ls_Value; end; end; end; procedure TApp_TOOLWindowStyle.Action_Edit_StyleCopyDispExecute(Sender: TObject); //表示されているスタイルをコピー begin if (ListBox_Style.Count > 0) then begin Clipboard.AsText := ListBox_Style.Items.Text; end; end; procedure TApp_TOOLWindowStyle.PopupMenu_StyleCopyPopup(Sender: TObject); begin Action_Edit_StyleCopySelect.Enabled := (ListBox_Style.ItemIndex >= 0) and (ListBox_Style.Items[ListBox_Style.ItemIndex][1] <> #9); end; procedure TApp_TOOLWindowStyle.Grid_WinInfoDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); const lci_MARGIN = 2; var l_Grid : TStringGrid; ls_Value : String; begin if not(Sender is TStringGrid) then begin Exit; end; l_Grid := TStringGrid(Sender); with l_Grid.Canvas do begin ls_Value := l_Grid.Cells[ACol, ARow]; if (ARow = 0) then begin //ヘッダーは中央に表示 FillRect(Rect); if (gfniRectWidth(Rect) >= TextWidth(ls_Value)) then begin DrawText(Handle, PChar(ls_Value), -1, Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or DT_CENTER); end else begin DrawText(Handle, PChar(ls_Value), -1, Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; end else begin { if (ACol = 0) and (State = []) then begin Brush.Color := l_Grid.FixedColor; end; } if (ls_Value <> '') and (ls_Value[1] = #1) then begin ls_Value := Copy(ls_Value, 2, MAXINT); if (State = []) then begin Brush.Color := clBtnFace; Font.Color := clBtnText; end; end; FillRect(Rect); Inc(Rect.Left, lci_MARGIN); DrawText(Handle, PChar(ls_Value), -1, Rect, DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER); end; end; end; procedure TApp_TOOLWindowStyle.Grid_WinInfoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var l_Grid : TStringGrid; li_Col : Integer; li_Row : Integer; begin if not(Sender is TStringGrid) then begin Exit; end; l_Grid := TStringGrid(Sender); if (Button = mbRight) then begin l_Grid.MouseToCell(X, Y, li_Col, li_Row); if (li_Row >= l_Grid.FixedRows) then begin l_Grid.Row := li_Row; end; end; end; procedure TApp_TOOLWindowStyle.Grid_WinInfoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); //セルのリサイズ(手抜き版) var l_Grid : TStringGrid; l_Point : TPoint; li_Col : Integer; li_Row : Integer; begin if not(Sender is TStringGrid) then begin Exit; end; if (Button = mbLeft) then begin TabSheet_WinInfoResize(nil); end else if (Button = mbRight) then begin l_Grid := TStringGrid(Sender); if (l_Grid.PopupMenu <> nil) then begin l_Grid.MouseToCell(X, Y, li_Col, li_Row); if (li_Row >= l_Grid.FixedRows) then begin l_Point := gfnptMousePosGet; l_Grid.PopupMenu.Popup(l_Point.X, l_Point.Y); end; end; end; end; //--- ヘルプ ------------------------------------------------------------------- procedure TApp_TOOLWindowStyle.Action_Help_VersionInfoExecute(Sender: TObject); begin gpcVersionInfoCreate; { gpcVersionInfoMemoSet( 'ウィンドウの親子関係をクラス名のインデントで表現'#13 + '上にいくほど手前のウィンドウ'#13#13 + '太字はマウス下にある一番手前のウィンドウ'#13 + '打ち消し表示はマウス位置にかからないウィンドウ'#13 + '淡色表示は非可視のウィンドウ'#13#13 + Format('「%s」でマウス位置にかからないウィンドウを非表示に', [gfnsShortCutTextErase(actWindow_PtInRect.Caption)]) + #13 + Format('「%s」で更に非可視ウィンドウを非表示に', [gfnsShortCutTextErase(actWindow_Visible.Caption)]) ); } gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/xe/tool/winstyle/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; //------------------------------------------------------------------------------ //--- 拡大縮小 ----------------------------------------------------------------- procedure TApp_TOOLWindowStyle.FSetStretchCaption; var ls_Value : String; li_Width : Integer; li_Height : Integer; begin ls_Value := ''; if (Image_Bitmap.Picture.Width > 0) or (Image_Bitmap.Picture.Height > 0) then begin gpcFitToVideoSizeGet(Image_Bitmap.Picture.Bitmap, Image_Bitmap.Width, Image_Bitmap.Height, li_Width, li_Height); ls_Value := Format('%.0f%%', [(li_Width / Image_Bitmap.Picture.Bitmap.Width) * 100]); end; if (ls_Value <> '') then begin Label_Stretch.Caption := Format('[ %s ]', [ls_Value]); end else begin Label_Stretch.Caption := ''; end; end; procedure TApp_TOOLWindowStyle.Action_Capture_Zoom100Execute(Sender: TObject); begin if not(Action_Capture_Zoom100.Enabled) then begin Exit; end; gpcImage_Zoom100(Image_Bitmap); FSetStretchCaption; end; procedure TApp_TOOLWindowStyle.Action_Capture_ZoomFitExecute(Sender: TObject); begin Image_Bitmap.Align := alClient; // Image_Bitmap.SetBounds(0, 0, Image_Bitmap.Parent.ClientWidth, Image_Bitmap.Parent.ClientHeight); FSetStretchCaption; end; procedure TApp_TOOLWindowStyle.Action_Capture_ZoomUpExecute(Sender: TObject); var li_Zoom : Integer; begin if (Action_Capture_ZoomDown.Enabled = False) or (Action_Capture_ZoomUp.Enabled = False) then begin Exit; end; if (Sender = Action_Capture_ZoomDown) then begin li_Zoom := -1; end else if (Sender = Action_Capture_ZoomUp) then begin li_Zoom := +1; end else begin li_Zoom := 0; end; if (li_Zoom <> 0) then begin Image_Bitmap.Align := alNone; gpcImage_Zoom(Image_Bitmap, li_Zoom); end; FSetStretchCaption; end; procedure TApp_TOOLWindowStyle.Grid_BitmapMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); //拡大 begin Action_Capture_ZoomUpExecute(Action_Capture_ZoomUp); end; procedure TApp_TOOLWindowStyle.Grid_BitmapMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); //縮小 begin Action_Capture_ZoomUpExecute(Action_Capture_ZoomDown); end; procedure TApp_TOOLWindowStyle.Image_BitmapDblClick(Sender: TObject); begin if (Image_Bitmap.Align = alClient) then begin Action_Capture_Zoom100Execute(nil); end else begin Action_Capture_ZoomFitExecute(nil); end; end; procedure TApp_TOOLWindowStyle.Image_BitmapMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Grid_Bitmap.CanFocus) then begin Grid_Bitmap.SetFocus; end; if (Button = mbLeft) // and (Image_Bitmap.Align <> alClient) then begin gpcImage_MoveStart(X, Y); end; end; procedure TApp_TOOLWindowStyle.Image_BitmapMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin gfnbImage_Move(Image_Bitmap, X, Y); end; procedure TApp_TOOLWindowStyle.Image_BitmapMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin gpcImage_MoveDone(Image_Bitmap, X, Y); end; end.