unit main; //{$DEFINE DEBUG} interface uses Windows, ActnList, AppEvnts, Buttons, Classes, ComCtrls, Controls, Dialogs, ExtCtrls, Forms, Graphics, ImgList, Menus, Messages, StdCtrls, SysUtils, ToolWin, my_settingfile, my_monitor, winlist; type { T_MyBounds = record Left, Top, Width, Height: Integer; end; } T_DispInfo = record //表示用 //カーソル位置のカラー情報 iRed, iGreen, iBlue : Integer; //RGB用 clColor, //HTML用 clColorRef : TColor; //COLORREF用 ptMousePos, //スクリーン座標、モニター座標 ptClientPos, //クライアント座標の原点, ptUserPos : TPoint; //任意座標の原点 hWinHandle : HWND; sWinClass : String; sWinText : WideString; szWindowSize, szClientSize : T_MyBounds; rcWinRect : TRect; sExeName : WideString; end; //http://hsp.tv/play/pforum.php?mode=pastwch&num=49524 const WM_DWMCOMPOSITIONCHANGED = $031E; type TApp_Puffbits = class(TForm) ActionList_Main: TActionList; actSpc: TAction; actZoom_1: TAction; actZoom_2: TAction; actZoom_3: TAction; actZoom_4: TAction; actZoom_6: TAction; actZoom_8: TAction; actZoom_10: TAction; actZoom_12: TAction; actZoom_16: TAction; actZoom_20: TAction; actZoom_Up: TAction; actZoom_Down: TAction; actGrid_Disp: TAction; actGrid_Gray: TAction; actGrid_Invert: TAction; actGrid_Transparent: TAction; actGrid_SelColor: TAction; actGrid_SubNone: TAction; actGrid_SubBlue: TAction; actGrid_SelSubColor: TAction; actColor_RGB: TAction; actColor_HTML: TAction; actColor_COLORREF: TAction; actColor_InfoOnOff: TAction; actPos_Screen: TAction; actPos_Client: TAction; actPos_User: TAction; actPos_UserPosSet: TAction; actPos_InfoOnOff: TAction; actWinInfo_Handle: TAction; actWinInfo_ClassName: TAction; actWinInfo_Text: TAction; actWinInfo_WindowSize: TAction; actWinInfo_ClientSize: TAction; actWinInfo_Rect: TAction; actWinInfo_ExeName: TAction; actWinInfo_InfoOnOff: TAction; actMenu_Main: TAction; actCopy_Picture: TAction; actCopy_All: TAction; actCopy_ColorHTML: TAction; actCopy_ColorRGB: TAction; actCopy_ColorCOLORREF: TAction; actCopy_PosScreen: TAction; actCopy_PosClient: TAction; actCopy_PosUser: TAction; actCopy_WinInfoHandle: TAction; actCopy_WinInfoClassName: TAction; actCopy_WinInfoText: TAction; actCopy_WinInfoWindowSize: TAction; actCopy_WinInfoClientSize: TAction; actCopy_WinInfoRect: TAction; actCopy_WinInfoExeName: TAction; actCapture_Pause: TAction; actCapture_Fixed: TAction; actCapture_Update: TAction; actCapture_Disp_x1: TAction; actOpt_StayOnTop: TAction; actOpt_BigFont: TAction; actOpt_NoSelfCapture: TAction; actOpt_SmoothCapture: TAction; actCustom_Setting: TAction; actCustom_ShortCut: TAction; actHelp: TAction; actFile_Minimize: TAction; actFile_Exit: TAction; actMove_Monitor: TAction; actMove_Left: TAction; actMove_Right: TAction; actMove_Up: TAction; actMove_Down: TAction; mnuMain: TPopupMenu; mniZoom: TMenuItem; mniZoom_1: TMenuItem; mniZoom_2: TMenuItem; mniZoom_3: TMenuItem; mniZoom_4: TMenuItem; mniZoom_6: TMenuItem; mniZoom_8: TMenuItem; mniZoom_10: TMenuItem; mniZoom_12: TMenuItem; mniZoom_16: TMenuItem; mniZoom_20: TMenuItem; mniGrid: TMenuItem; mniGrid_Disp: TMenuItem; mniGrid_LineGrid: TMenuItem; mniGrid_Gray: TMenuItem; mniGrid_Invert: TMenuItem; mniGrid_Transparent: TMenuItem; mniGrid_SelColor: TMenuItem; mniGrid_LineSubGrid: TMenuItem; mniGrid_SubNone: TMenuItem; mniGrid_SubBlue: TMenuItem; mniGrid_SelSubColor: TMenuItem; mniMain_Line1: TMenuItem; mniColor: TMenuItem; mniColor_RGB: TMenuItem; mniColor_HTML: TMenuItem; mniColor_ColorRef: TMenuItem; mniColor_Line1: TMenuItem; mniColor_InfoOnOff: TMenuItem; mniPos: TMenuItem; mniPos_Screen: TMenuItem; mniPos_Client: TMenuItem; mniPos_User: TMenuItem; mniPos_Line1: TMenuItem; mniPos_InfoOnOff: TMenuItem; mniWinInfo: TMenuItem; mniWinInfo_Handle: TMenuItem; mniWinInfo_ClassName: TMenuItem; mniWinInfo_Text: TMenuItem; mniWinInfo_WindowSize: TMenuItem; mniWinInfo_ClientSize: TMenuItem; mniWinInfo_Rect: TMenuItem; mniWinInfo_ExeName: TMenuItem; mniWinInfo_Line1: TMenuItem; mniWinInfo_InfoOnOff: TMenuItem; mniMain_Line2: TMenuItem; mniCopy: TMenuItem; mniCopy_Picture: TMenuItem; mniCopy_Line1: TMenuItem; mniCopy_ColorRGB: TMenuItem; mniCopy_ColorHTML: TMenuItem; mniCopy_ColorColorRef: TMenuItem; mniCopy_Line2: TMenuItem; mniCopy_PosScreen: TMenuItem; mniCopy_PosClient: TMenuItem; mniCopy_PosUser: TMenuItem; mniCopy_Line3: TMenuItem; mniCopy_WInfoHandle: TMenuItem; mniCopy_WInfoClassName: TMenuItem; mniCopy_WInfoText: TMenuItem; mniCopy_WInfoWindowSize: TMenuItem; mniCopy_WInfoClientSize: TMenuItem; mniCopy_WInfoRect: TMenuItem; mniCopy_WInfoExeName: TMenuItem; mniCopy_Line4: TMenuItem; mniCopy_All: TMenuItem; mniCapture: TMenuItem; mniCapture_Pause: TMenuItem; mniCapture_Fixed: TMenuItem; mniCapture_Line1: TMenuItem; mniCapture_Upload: TMenuItem; mniOpt: TMenuItem; mniOpt_StayOnTop: TMenuItem; mniOpt_FontSize: TMenuItem; mniOpt_NoSelfCapture: TMenuItem; mniOpt_SmoothCapture: TMenuItem; mniOpt_Line1: TMenuItem; mniCustom_Setting: TMenuItem; mniCustom_ShortCut: TMenuItem; mniMain_Line3: TMenuItem; mniFile_Exit: TMenuItem; mnuTool_Grid: TPopupMenu; mnuTool_Color: TPopupMenu; mnuTool_Pos: TPopupMenu; mnuTool_WinInfo: TPopupMenu; mnuTool_Opt: TPopupMenu; ToolBar_Main: TToolBar; btnTool_Grid: TToolButton; btnTool_Color: TToolButton; btnTool_Pos: TToolButton; btnTool_WinInfo: TToolButton; btnTool_Opt: TToolButton; pnlCapture: TPanel; btnCapture_MoveLeft: TSpeedButton; btnCapture_MoveUp: TSpeedButton; btnCapture_MoveDown: TSpeedButton; btnCapture_MoveRight: TSpeedButton; Timer_Main: TTimer; Timer_Infomation: TTimer; Timer_CaptureMove: TTimer; ImageList_Icon: TImageList; ImageList_Main: TImageList; ColorDialog: TColorDialog; ApplicationEvents1: TApplicationEvents; mniMain_Line4: TMenuItem; mniHelp: TMenuItem; procedure FormCreate (Sender: TObject); procedure FormDestroy (Sender: TObject); procedure FormResize (Sender: TObject); procedure FormPaint (Sender: TObject); procedure FormDblClick (Sender: TObject); procedure FormKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormMouseWheelUp (Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure actNop (Sender: TObject); procedure actZoomExecute (Sender: TObject); procedure actZoom_UpExecute (Sender: TObject); procedure actZoom_DownExecute (Sender: TObject); procedure actGrid_DispExecute (Sender: TObject); procedure actGrid_SubBlueExecute (Sender: TObject); procedure actGrid_ColorExecute (Sender: TObject); procedure actGrid_SelColorExecute (Sender: TObject); procedure actPos_UserPosSetExecute (Sender: TObject); procedure actColor_InfoOnOffExecute (Sender: TObject); procedure actPos_InfoOnOffExecute (Sender: TObject); procedure actWinInfo_InfoOnOffExecute (Sender: TObject); procedure actMenu_MainExecute (Sender: TObject); procedure actCopy_PictureExecute (Sender: TObject); procedure actCopy_TextExecute (Sender: TObject); procedure actCopy_AllExecute (Sender: TObject); procedure actOpt_StayOnTopExecute (Sender: TObject); procedure actOpt_BigFontExecute (Sender: TObject); procedure actOpt_NoSelfCaptureExecute (Sender: TObject); procedure actOpt_SmoothCaptureExecute (Sender: TObject); procedure actCustom_SettingExecute (Sender: TObject); procedure actCustom_ShortCutExecute (Sender: TObject); procedure actCapture_PauseExecute (Sender: TObject); procedure actCapture_FixedExecute (Sender: TObject); procedure actCapture_UpdateExecute (Sender: TObject); procedure actFile_MinimizeExecute (Sender: TObject); procedure actFile_ExitExecute (Sender: TObject); procedure actMove_MonitorExecute (Sender: TObject); procedure actMove_LeftExecute (Sender: TObject); procedure btnTool_GridMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnCapture_MoveLeftMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnCapture_MoveLeftMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure pnlToolBarMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Timer_MainTimer (Sender: TObject); procedure Timer_InfomationTimer (Sender: TObject); procedure Timer_CaptureMoveTimer (Sender: TObject); procedure ApplicationEvents1Activate (Sender: TObject); procedure ApplicationEvents1Deactivate(Sender: TObject); procedure ApplicationEvents1ShortCut (var Msg: TWMKey; var Handled: Boolean); procedure ApplicationEvents1Message (var Msg: tagMSG; var Handled: Boolean); private { Private 宣言 } F_bThrough : Boolean; //無用なイベントを捨てる F_bThroughTimer : Boolean; //タイマーイベントで処理し切れなかったイベントを捨てるため F_iZoom, //倍率 F_iZoomIndex, //選択されている倍率メニューのインデックス F_iZoomBak : Integer; //一時停止、定点キャプチャ時にShiftを押したとき一時的に倍率を1倍にするために必要 F_clGridColor, //グリッドの色 F_clSubGridColor : TColor; //サブグリッドの色 F_pmPenMode : TPenMode; //反転色、半透明色があるために必要 F_bmpDesktop, //一時停止時にデスクトップをキャッシュ F_bmpNoSelf, //一時停止時の自身をキャプチャしないデスクトップのキャッシュ F_bmpZoom : TBitmap; //最終的にこれがSelf.Canvasにコピーされる F_szDesktop, //拡大元の大きさ F_szZoom : T_MyBounds; //拡大後の大きさ。二つともにLeft,Topの値は中心を示すために使用していることに注意 F_iRulerWidth : Integer; //ルーラーの幅 F_iHGrid, F_iVGrid : Integer; //グリッドの数 //情報表示部 F_rcInfo : TRect; //情報表示領域 F_sInfomation : WideString; //1行表示 F_ptColorPos : TPoint; //色情報を得る為の位置 カーソルボックスもこの値を利用している F_iFontHeight : Integer; //文字の高さ＝一行の高さ F_iInfoLeft : Integer; //ステータスアイコン表示のLeft値 F_iVLine : Integer; //情報表示の項目名と情報との境に引くラインの横の位置 F_iPassTime : DWORD; //前回キャプチャからの経過時間 F_rDispInfo : T_DispInfo; //表示用の情報 FWinList : T_WinList; //一時停止時に表示されているウィンドウすべての情報を保持するリスト F_ptGesture : TPoint; //マウスジェスチャー // F_ptFollow : TPoint; //スタイル詳細ウィンドウの追従用 //一時停止時にキャプチャポジションを移動させる F_bDragMove : Boolean; //フォームをつかんでいるか F_ptDragClientPos : TPoint; //マウスポインタにキャプチャポインタを移動させるため F_ptDragScreenPos : TPoint; //フォームをつかんでキャプチャポインタを動かすため F_iMonitorNum : Integer; //前回カーソルがあったモニターの番号（モニターの範囲外にカーソルポイントが移動しないために） //スピードボタンでキャプチャポイントを移動させるため F_MoveButton : TSpeedButton; procedure F_Capture_KeyUp; procedure F_Capture_MovePoint(ptPos: TPoint); procedure F_Zoom_UpDown(Sender: TObject); procedure F_SetPoint; function F_GetPointShift: Integer; procedure F_PushInfomation(sText: WideString); function F_GetWindow(ptPos: TPoint): HWND; function F_GetDispFmt(iIndex: Integer): String; function F_GetCopyFmt(iIndex: Integer): String; function F_GetCopyZoomGrid: Boolean; procedure F_PutInfo(Sender: TObject; var iInfoTop: Integer); function F_GetDrawFont: TFont; function F_LoadBin: Boolean; procedure F_SaveBin; procedure FCheckAeroThemeEnabled(Sender: TObject); procedure WMDwmCompositiOnChanged(var Msg: TMessage); message WM_DWMCOMPOSITIONCHANGED; procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; procedure WMApp (var Msg: TMessage); message WM_APP; procedure WMDisplayChange (var Msg: TMessage); message WM_DISPLAYCHANGE; procedure WMSysCommand (var Msg: TWMSysCommand); message WM_SYSCOMMAND; procedure WMEraseBkGnd (var Msg: TMessage); message WM_ERASEBKGND; protected // procedure CreateParams(var Params: TCreateParams); override; public { Public 宣言 } function Get_CommandToAction(iCmd: Word): TAction; function Get_ActionToCommand(AAction: TAction): Word; procedure DrawNow; procedure MoveCursorToPoint(Sender: TObject); procedure SetMenuVisible(MenuItem: TMenuItem; bVisible: Boolean); property CopyFmt[iIndex: Integer]: String read F_GetCopyFmt;// write F_SetCopyFmt; property DrawFont: TFont read F_GetDrawFont; end; //------------------------------------------------------------------------------ var App_Puffbits: TApp_Puffbits; //準汎用フォーム用 G_MainForm: TApp_Puffbits; G_ActionList: TActionList; const G_csAPPTITLE = 'puffbits'; implementation uses {$IFDEF DEBUG} myDebug, {$ENDIF} Clipbrd, CommCtrl, // my_inifile, custom_shortcut, setting, general; {$R *.dfm} const CAPTUREBLT = $40000000; //レイヤーウィンドウも含めたキャプチャを行うフラグ const //マウスを動かしていない時であっても画面更新を行う時間(ミリ秒) FciCapture_RefleshTime = 1000; const FciMINGRID = 4; //グリッドを引く最低倍率 FciMINSIZE = 50; //描画領域の最小の高さ＆フォームの幅 //フォーマットの初期値 const G_ciFMTZOOM = 0; G_ciFMTCOLOR_RGB = 1; G_ciFMTCOLOR_HTML = 2; G_ciFMTCOLOR_COLORREF = 3; G_ciFMTPOS_SCREEN = 4; G_ciFMTPOS_CLIENT = 5; G_ciFMTPOS_USER = 6; G_ciFMTWININFO_HANDLE = 7; G_ciFMTWININFO_CLASSNAME = 8; G_ciFMTWININFO_TEXT = 9; G_ciFMTWININFO_WINDOWSIZE = 10; G_ciFMTWININFO_CLIENTSIZE = 11; G_ciFMTWININFO_RECT = 12; G_ciFMTWININFO_CONTROLID = 13; G_ciFMTWININFO_EXENAME = 14; G_ciFMTCOUNT = G_ciFMTWININFO_EXENAME; const G_csDISPFMT: array[0..G_ciFMTCOUNT] of String = ( '%2d倍', //6倍 'RGB R=%-3d G=%-3d B=%-3d', //RGB 'HTML %s', //HTML 'COLORREF %1:s %0:d', //引数は二つ。順番を入れ替えている 'ｽｸﾘｰﾝ X=%d Y=%d', // 'ｸﾗｲｱﾝﾄ X=%d Y=%d (%d,%d)', //()内はクライアントの原点 '長さ W=%d H=%d (%d,%d)', //()内はユーザー指定の原点 'ﾊﾝﾄﾞﾙ %s %d', //引数は二つ。 'ｸﾗｽ名 %s', // 'ﾃｷｽﾄ %s', // 'Wｻｲｽﾞ L=%2:d T=%3:d W=%0:d H=%1:d', //Left, Top, Width, Height(親ウィンドウのクライアント座標) 'Cｻｲｽﾞ W=%d H=%d', //Width, Height(Left, Topは必ず0なので省略) 'Rect L=%d T=%d R=%d B=%d', //Left, Top, Right, Bottom 'ｺﾝﾄﾛｰﾙID %d', //10進のみ '実行ﾌｧｲﾙ %s' //実行ファイル名 ); lcsFMT_COPY = '%sをｺﾋﾟｰ %s'; //コピーしたときのメッセージ lcsMARK_PICTURE = 'ｽﾞｰﾑ画像'; //ズーム画像をコピーしたときに付加するメッセージ lcsMARK_FIXED = '(%d,%d) '; //定点キャプチャ const G_csCOPYFMT: array[0..G_ciFMTCOUNT, 0..1] of String = ( ('11', '01'), //画像 ('%d %d %d', '%x %x %x'), //RGB ('%.6x', '%d'), //HTML ('%d', '%x'), //COLORREF ('%d, %d', '(%d, %d)'), //Screen ('%d, %d', '(%d, %d)'), //Client ('%d, %d', '(%d, %d)'), //User ('%d', '%.8x'), //Handle ('%s', '"%s"'), //ClassName ('%s', '"%s"'), //Text ('%d, %d, %d, %d', '(%d, %d, %d, %d)'), //Window Size ('%d, %d', '(%d, %d)'), //Client Size ('%d, %d, %d, %d', '(%d, %d, %d, %d)'), //Rect ('%d', '%d'), //コントロールID ('%s', '%1:s') //Exe Name ); const //タスクバーのメニュー拡張 lciMENU_LINE = 100; lciMENU_MOVEMONITOR = 201; //============================================================================== procedure TApp_Puffbits.WMEraseBkGnd(var Msg: TMessage); begin //http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200504/05040066.txt Msg.Result:=0; end; //------------------------------------------------------------------------------ //ディスプレイ設定が変わった procedure TApp_Puffbits.WMDisplayChange(var Msg: TMessage); var i : Integer; begin if not(actCapture_Pause.Checked) then begin //一時停止中は一時停止した時点のモニター情報を使うためスキップ MyScreenSize.Reflesh; end; for i := 0 to Screen.FormCount -1 do begin //TScreenがディスプレイの変更に追従しないバグへの対策。 TForm(Screen.Forms[i]).Monitor; end; //モニター内に納まるようなSetBouds //フォームスタイルが標準のツールバーなら何もしなくてもモニター内に収まる { F_Monitors.SetBounds(App_Puffbits, Left, Top, Width, Height); if (App_PuffbitsSetting <> nil) then begin with App_PuffbitsSetting do begin F_Monitors.SetBounds(App_PuffbitsSetting, Left, Top, Width, Height); end; end; if (App_PuffbitsWindowStyle <> nil) then begin with App_PuffbitsWindowStyle do begin F_Monitors.SetBounds(App_PuffbitsWindowStyle, Left, Top, Width, Height); end; end; } end; procedure TApp_Puffbits.WMDwmCompositiOnChanged(var Msg: TMessage); begin FCheckAeroThemeEnabled(nil); end; procedure TApp_Puffbits.FCheckAeroThemeEnabled(Sender: TObject); var lb_NoSelf : Boolean; begin if (gfnbIsAeroThemeEnabled) then begin if (actCapture_Pause.Checked and Assigned(FWinList) and not(FWinList.AeorThemeEnabled)) then begin //一時停止中にエアロテーマが無効の場合は現在エアロテーマが有効であってもメッセージは出さない Exit; end; lb_NoSelf := False; if (Sender = nil) or (Sender = actOpt_NoSelfCapture) then begin lb_NoSelf := actOpt_NoSelfCapture.Checked; end; if (lb_NoSelf) then begin actOpt_NoSelfCapture.Checked := False; gpcShowMessage(Format('Aero テーマが有効の場合「%s」の機能は使用できません'#13'機能を解除します', [StripHotKey(actOpt_NoSelfCapture.Caption)])); end; end; end; procedure TApp_Puffbits.WMSysCommand(var Msg: TWMSysCommand); begin //myDebug.gpcDebugAdd('WMSysCommand', Msg.CmdType); case Msg.CmdType of SC_MAXIMIZE: begin end; 61490: begin //タイトルバーのダブルクリック end; { 61587: begin actMenu_MainExecute(nil); end; } else begin inherited; end; end; end; //OS終了メッセージ procedure TApp_Puffbits.WMQueryEndSession(var Msg: TWMQueryEndSession); begin //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm // Close; FormDestroy(Self); Msg.Result := 1; end; //タスクバーのメニュー拡張 procedure TApp_Puffbits.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); begin if (Msg.hwnd = Application.Handle) then begin if (Msg.message = WM_SYSCOMMAND) then begin case Msg.wParam of lciMENU_MOVEMONITOR: actMove_MonitorExecute(nil); end; end; end; end; procedure TApp_Puffbits.SetMenuVisible(MenuItem: TMenuItem; bVisible: Boolean); var l_ToolButton: TToolButton; l_Menu: TPopupMenu; begin l_ToolButton := nil; l_Menu := nil; if (MenuItem = mniGrid) then begin l_ToolButton := btnTool_Grid; l_Menu := mnuTool_Grid; end else if (MenuItem = mniColor) then begin l_ToolButton := btnTool_Color; l_Menu := mnuTool_Color; end else if (MenuItem = mniPos) then begin l_ToolButton := btnTool_Pos; l_Menu := mnuTool_Pos; end else if (MenuItem = mniWinInfo) then begin l_ToolButton := btnTool_WinInfo; l_Menu := mnuTool_WinInfo; end else if (MenuItem = mniOpt) then begin l_ToolButton := btnTool_Opt; l_Menu := mnuTool_Opt; end else if (Self.FindComponent(MenuItem.Name + '_Tool') <> nil) then begin TMenuItem(Self.FindComponent(MenuItem.Name + '_Tool')).Visible := bVisible; end; MenuItem.Visible := bVisible; if (l_ToolButton <> nil) then begin if (bVisible) then begin // l_ToolButton.Style := tbsDropDown; l_ToolButton.DropdownMenu := l_Menu; end else begin // l_ToolButton.Style := tbsButton; l_ToolButton.DropdownMenu := nil; end; end; FormResize(nil); end; procedure TApp_Puffbits.FormCreate(Sender: TObject); procedure lpc_ToolMenuSet(mnuTool: TPopupMenu; mniMenu: TMenuItem); var i: Integer; l_MenuItem: TMenuItem; begin for i := 0 to mniMenu.Count -1 do begin l_MenuItem := TMenuItem.Create(Self); l_MenuItem.Name := mniMenu.Items[i].Name + '_Tool'; if (mniMenu.Items[i].Caption <> '-') then begin l_MenuItem.Action := mniMenu.Items[i].Action; l_MenuItem.GroupIndex := mniMenu.Items[i].GroupIndex; l_MenuItem.RadioItem := mniMenu.Items[i].RadioItem; end else begin l_MenuItem.Caption := '-'; end; mnuTool.Items.Add(l_MenuItem); end; end; var lh_Menu : HMENU; lrc_Rect : TRect; begin {$IFDEF DEBUG} myDebug.gpcMessageModeSet(True); {$ENDIF} //------------------------------------------------------------------------------ //準汎用フォーム用 G_MainForm := Self; G_ActionList := ActionList_Main; gpcSetInitShortCut(ActionList_Main); gpcSetInitMouseGesture( actOpt_StayOnTop, //上 actCustom_Setting, //下 actGrid_Disp, //左 actCapture_Pause //右 ); //------------------------------------------------------------------------------ lrc_Rect := gfnrcMonitorRectGet(gfnptMousePosGet); SetBounds(lrc_Rect.Left + 75, lrc_Rect.Top + 75, Width, Height); F_bThrough := False; F_bDragMove := False; F_ptGesture := Point(-1, -1); // F_ptFollow := Point(-1, -1); F_iMonitorNum := 0; F_iZoomIndex := mniZoom.Tag; F_iZoom := mniZoom.Items[F_iZoomIndex].Tag; F_iZoomBak := -1; F_clGridColor := actGrid_Gray.Tag; F_pmPenMode := pmCopy; F_clSubGridColor := actGrid_SubBlue.Tag; pnlCapture.Left := ClientWidth - pnlCapture.Width; //最大化メニューを削除。 lh_Menu := GetSystemMenu(Self.Handle, False); DeleteMenu (lh_Menu, SC_MAXIMIZE, MF_BYCOMMAND); DrawMenuBar(lh_Menu); //タスクバーのメニュー。モニター間移動を挿入 lh_Menu := GetSystemMenu(Application.Handle, False); InsertMenu(lh_Menu, 0, MF_BYPOSITION or MF_SEPARATOR, 0, nil); InsertMenu(lh_Menu, 0, MF_BYPOSITION, lciMENU_MOVEMONITOR, PChar(actMove_Monitor.Caption)); // InsertMenu(lh_Menu, 0, MF_BYPOSITION or MF_POPUP, mnuMain.Handle, PChar(Application.Title)); DrawMenuBar(lh_Menu); //一時停止時の画面キャプチャ F_bmpDesktop := TBitmap.Create; F_bmpDesktop.Canvas.Brush.Color := clBlack; F_bmpDesktop.Width := MyScreenSize.ScreenWidth; F_bmpDesktop.Height := MyScreenSize.ScreenHeight; //一時停止時の画面キャプチャ(自身をキャプチャしない) F_bmpNoSelf := TBitmap.Create; F_bmpNoSelf.Canvas.Brush.Color := clBlack; F_bmpNoSelf.Width := MyScreenSize.ScreenWidth; F_bmpNoSelf.Height := MyScreenSize.ScreenHeight; F_bmpZoom := TBitmap.Create; F_bmpZoom.HandleType := bmDIB; F_bmpZoom.Canvas.Font := Self.Font; F_bmpZoom.Canvas.Font.Color := clWindowText; //情報表示領域の初期設定 with F_rcInfo do begin Left := 0; Right := ClientWidth; Top := ClientHeight; Bottom := ClientHeight; end; //一覧設定フォーム App_PuffbitsSetting := nil; //設定情報読み込み if not(F_LoadBin) then begin actOpt_BigFontExecute(actOpt_BigFont); G_pcShortCutInit; end; if not(gfnbIsAlphaBlendReady) then begin //9x系と2000以前はAlphaBlendに非対応 actOpt_NoSelfCapture.Enabled := False; actOpt_NoSelfCapture.Visible := False; Self.AlphaBlend := False; end; if not(G_bIsNtOS) then begin //9x系では実行ファイル名を取得できない actWinInfo_ExeName.Enabled := False; actWinInfo_ExeName.Visible := False; actCopy_WinInfoExeName.Enabled := False; actCopy_WinInfoExeName.Visible := False; end; //ツールバーのメニュー lpc_ToolMenuSet(mnuTool_Grid, mniGrid); lpc_ToolMenuSet(mnuTool_Color, mniColor); lpc_ToolMenuSet(mnuTool_Pos, mniPos); lpc_ToolMenuSet(mnuTool_WinInfo, mniWinInfo); lpc_ToolMenuSet(mnuTool_Opt, mniOpt); Timer_Main.Enabled := True; Tag := 1; Show; //これがないとプライマリモニターの外に表示されてしまうことがある、不可解。 if not(actOpt_StayOnTop.Checked) then begin SetWindowPos(Self.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); SetWindowPos(Self.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE); end; end; //破棄 procedure TApp_Puffbits.FormDestroy(Sender: TObject); begin if (Self.Tag = 0) then begin Exit; end; Tag := 0; Timer_Main.Enabled := False; if (IsZoomed(Handle)) or (IsIconic(Handle)) then begin //最大化、最小化されていたら元に戻す ShowWindow(Handle, SW_NORMAL); end; F_SaveBin; //↓はこの位置でないとエラーになる F_bmpDesktop.Free; F_bmpNoSelf.Free; F_bmpZoom.Free; FWinList.Free; end; //フォームへ描画 procedure TApp_Puffbits.FormPaint(Sender: TObject); begin //拡大画像の描画。これがメイン。 Windows.BitBlt(Canvas.Handle, 0, ToolBar_Main.Height, ClientWidth, ClientHeight - ToolBar_Main.Height, F_bmpZoom.Canvas.Handle, 0, 0, SRCCOPY); if (GetActiveWindow = Self.Handle) then begin Canvas.Pen.Color := clActiveCaption; end else begin Canvas.Pen.Color := clInActiveCaption; end; Canvas.Pen.Mode := pmCopy; Canvas.MoveTo(0, 0); Canvas.LineTo(0, ClientHeight -1); Canvas.LineTo(ClientWidth -1, ClientHeight -1); Canvas.LineTo(ClientWidth -1, 0); Canvas.LineTo(0, 0); end; //描画領域の変更 procedure TApp_Puffbits.FormResize(Sender: TObject); //ズーム領域調整関数 function lfnrc_RectMagni(const rcRect: TRect; const fMagni: Extended): TRect; begin Result := Rect(0, 0, gfniRoundUp(fMagni * gfniRectWidth(rcRect)), gfniRoundUp(fMagni * gfniRectHeight(rcRect))); end; //============================================================================ var i, li_ShiftColorPos, li_ShiftLine, li_10Line: Integer; li_Width, li_Height: Integer; lrc_Screen, lrc_Zoom: TRect; begin if (Tag = 0) then begin Exit; end else begin Tag := 0; end; //情報表示枠の高さをセット------------------------------------------------------ li_Height := 0; F_PutInfo(Sender, li_Height); ClientHeight := ClientHeight + (li_Height - gfniRectHeight(F_rcInfo)); if ((ClientHeight - li_Height) < FciMINSIZE) then ClientHeight := FciMINSIZE + li_Height; if (ClientWidth < FciMINSIZE) then ClientWidth := FciMINSIZE; with F_rcInfo do begin Right := ClientWidth; Bottom := ClientHeight - ToolBar_Main.Height; Top := Bottom - li_Height; end; pnlCapture.Top := F_rcInfo.Top + ToolBar_Main.Height +1; //拡大のための領域のセット------------------------------------------------------ //ルーラー幅のセット if (actGrid_Disp.Checked) then begin F_iRulerWidth := 7; end else begin F_iRulerWidth := 0; end; with F_bmpZoom do begin Width := Self.ClientWidth; Height := Self.ClientHeight - ToolBar_Main.Height; end; //拡大元の領域 := ズーム表示領域 / 倍率 lrc_Screen := lfnrc_RectMagni(Rect(0, 0, ClientWidth - F_iRulerWidth, F_rcInfo.Top - F_iRulerWidth), 1/F_iZoom); //(端数が出ないように調整された)拡大される領域 lrc_Zoom := lfnrc_RectMagni(lrc_Screen, F_iZoom); //拡大後の領域情報 with F_szZoom do begin Width := gfniRectWidth(lrc_Zoom); Height := gfniRectHeight(lrc_Zoom); //Left,Top は中心を示すことに注意 Left := gfniRound(Width / 2) -1; Top := gfniRound(Height / 2) -1; //グリッドの数 F_iHGrid := gfniRound(Width / F_iZoom); F_iVGrid := gfniRound(Height / F_iZoom); end; //拡大元の領域情報 with F_szDesktop do begin Width := gfniRectWidth(lrc_Screen); Height := gfniRectHeight(lrc_Screen); //Left,Top は中心を示すことに注意 Left := gfniRound(Width / 2) -1; Top := gfniRound(Height / 2) -1; end; //グリッドを引くか引かないかでカラーの値を取る位置が1ドットずれる if (F_GetPointShift > 1) then begin li_ShiftColorPos := 1; //グリッドあり、1ドット右下にずらす end else begin li_ShiftColorPos := 0; //グリッドなし、そのまま end; //カラー取得位置 F_ptColorPos := Point( F_iRulerWidth + (gfniRound(F_iHGrid / 2) -1) * F_iZoom + li_ShiftColorPos, //X F_iRulerWidth + (gfniRound(F_iVGrid / 2) -1) * F_iZoom + li_ShiftColorPos //Y ); //ルーラー描画------------------------------------------------------------------ if (actGrid_Disp.Checked) then begin with F_bmpZoom.Canvas do begin //PenとBrushをセット Pen.Mode := pmCopy; Brush.Color := clWhite; // FillRect(Rect(0, 0, ClientWidth, F_rcInfo.Top)); FillRect(Rect(0, 0, ClientWidth, F_iRulerWidth)); //ルーラーの幅と高さは同じなのでF_iRulerWidthで代用 FillRect(Rect(0, 0, F_iRulerWidth, F_rcInfo.Top)); li_ShiftLine := (gfniRound(F_iHGrid / 2) -1) mod 5; li_10Line := (gfniRound(F_iHGrid / 2) -1) mod 10; for i := 0 to F_iHGrid do begin li_Width := i * F_iZoom + F_iRulerWidth; if (i = 0) then begin MoveTo(li_Width, 0); LineTo(li_Width, F_iRulerWidth); end else if (i mod 5 = li_ShiftLine) then begin Pen.Color := TColor($ff0000); if (i mod 10 = li_10Line) then begin MoveTo(li_Width, 0); LineTo(li_Width, F_iRulerWidth -2); end else begin MoveTo(li_Width, 0); LineTo(li_Width, F_iRulerWidth -4); end; Pen.Color := clGray; end else if (F_iZoom >= 2) then begin MoveTo(li_Width, 0); LineTo(li_Width, F_iRulerWidth -5); end; end; li_ShiftLine := (gfniRound(F_iVGrid / 2) -1) mod 5; li_10Line := (gfniRound(F_iVGrid / 2) -1) mod 10; for i := 0 to F_iVGrid do begin li_Height := i * F_iZoom + F_iRulerWidth; if (i = 0) then begin MoveTo(0, li_Height); LineTo(F_iRulerWidth, li_Height); end else if (i mod 5 = li_ShiftLine) then begin Pen.Color := TColor($ff0000); if (i mod 10 = li_10Line) then begin MoveTo(0, li_Height); LineTo(F_iRulerWidth -2, li_Height); end else begin MoveTo(0, li_Height); LineTo(F_iRulerWidth -4, li_Height); end; Pen.Color := clGray; end else if (F_iZoom >= 2) then begin MoveTo(0, li_Height); LineTo(F_iRulerWidth -5, li_Height); end; end; //マーカーを描画 if (F_iZoom = 1) then begin li_ShiftColorPos := F_iZoom div 2; end else begin li_ShiftColorPos := F_iZoom div 2 -1; //より真ん中へ表示させるために-1 end; Pen.Color := clRed; Brush.Color := Pen.Color; Polygon([Point(F_ptColorPos.X + li_ShiftColorPos, F_iRulerWidth -1), Point(F_ptColorPos.X + li_ShiftColorPos -2, F_iRulerWidth -3), Point(F_ptColorPos.X + li_ShiftColorPos +2, F_iRulerWidth -3)]); Polygon([Point(F_iRulerWidth -1, F_ptColorPos.Y + li_ShiftColorPos), Point(F_iRulerWidth -3, F_ptColorPos.Y + li_ShiftColorPos -2), Point(F_iRulerWidth -3, F_ptColorPos.Y + li_ShiftColorPos +2)]); //ペンを元に戻す Pen.Color := TColor(actGrid_SelColor.Tag); end; end; Tag := 1; Timer_InfomationTimer(nil); DrawNow; end; //描画スタート・今すぐ描画 procedure TApp_Puffbits.DrawNow; begin if (Tag <> 0) then begin F_iPassTime := 0; //すぐに再描画させたい為に間隔判定用のフラグを0にセットする。 Timer_MainTimer(Timer_Main); Timer_Main.Tag := 100; //マウスが動いていなくても画面更新を行う時間を一度だけ短くする。 end; end; //------------------------------------------------------------------------------ //マウスカーソルのカーソルポイントを示すボックスを描く時の枠の幅を返す //倍率選択とグリッド色選択で使用する function TApp_Puffbits.F_GetPointShift: Integer; begin if (actGrid_Disp.Checked) and (F_iZoom >= FciMINGRID) then begin Result := 2; //グリッドの線を避けるため1ドット足して2 end else begin //※グリッドとカーソルボックスの線の引き方は違っている Result := 1; //グリッド表示がないので1ですむ end; end; //倍率選択 procedure TApp_Puffbits.actZoomExecute(Sender: TObject); begin with (Sender as TAction) do begin Checked := True; F_iZoom := Abs(Tag); F_iZoomIndex := (Self.FindComponent('mni' + Copy(Name, 4, Length(Name) -3)) as TMenuItem).MenuIndex; end; FormResize(nil); end; //倍率の上下 procedure TApp_Puffbits.F_Zoom_UpDown(Sender: TObject); var li_Zoom: Integer; begin if (F_iZoomBak > 0) then Exit; if (Sender = actZoom_Up) then begin li_Zoom := 1; end else if (Sender = actZoom_Down) then begin li_Zoom := -1; end else begin Exit; end; if ((li_Zoom = -1) and (F_iZoomIndex <= 0)) //倍率が既に最低の時 or ((li_Zoom = 1) and (F_iZoomIndex >= mniZoom.Count -1)) //倍率が既に最高の時 then begin Exit; end; actZoomExecute(mniZoom.Items[gfniNumLimit(F_iZoomIndex + li_Zoom, 0, mniZoom.Count -1)].Action); end; procedure TApp_Puffbits.actZoom_UpExecute(Sender: TObject); begin F_Zoom_UpDown(actZoom_Up); end; procedure TApp_Puffbits.actZoom_DownExecute(Sender: TObject); begin F_Zoom_UpDown(actZoom_Down); end; //ホイールで倍率の上下 procedure TApp_Puffbits.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin //F_bThroughがTrueなら処理しきれないイベントを捨てる // if (F_bThrough) then Exit; F_bThrough := True; if (ssAlt in Shift) then begin //カーソル移動→ actMove_LeftExecute(actMove_Right); end else if (ssCtrl in Shift) then begin //カーソル移動↓ actMove_LeftExecute(actMove_Down); end else begin //倍率→低 F_Zoom_UpDown(actZoom_Down); end; Handled := True; Application.ProcessMessages; //溜まってるイベントを捨てる F_bThrough := False; end; procedure TApp_Puffbits.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin //F_bThroughがTrueなら処理しきれないイベントを捨てる // if (F_bThrough) then Exit; F_bThrough := True; if (ssAlt in Shift) then begin //カーソル移動← actMove_LeftExecute(actMove_Left); end else if (ssCtrl in Shift) then begin //カーソル移動↑ actMove_LeftExecute(actMove_Up); end else begin //倍率→高 F_Zoom_UpDown(actZoom_Up); end; Handled := True; Application.ProcessMessages; //溜まってるキューを捨てる F_bThrough := False; end; //------------------------------------------------------------------------------ //グリッド procedure TApp_Puffbits.WMApp(var Msg: TMessage); //ツールバーがtbsDropDownでも押されたらへこんだままのチェック状態になるようにするため begin if (btnTool_Grid.Style = tbsDropDown) then begin btnTool_Grid.Down := actGrid_Disp.Checked; end; end; procedure TApp_Puffbits.btnTool_GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin PostMessage(Handle, WM_APP, 0, 0); end; procedure TApp_Puffbits.actGrid_DispExecute(Sender: TObject); //グリッド表示ON/OFF begin actGrid_Disp.Checked := not(actGrid_Disp.Checked); FormResize(nil); DrawNow; end; procedure TApp_Puffbits.actGrid_ColorExecute(Sender: TObject); //グリッド色、灰、黒、白 begin TAction(Sender).Checked := True; F_clGridColor := TComponent(Sender).Tag; if (Sender = actGrid_Invert) then begin //反転色 F_pmPenMode := pmNot; end else if (Sender = actGrid_Transparent) then begin F_pmPenMode := pmMask; end else begin F_pmPenMode := pmCopy; end; DrawNow; end; //サブグリッド色、青・赤 procedure TApp_Puffbits.actGrid_SubBlueExecute(Sender: TObject); begin TAction(Sender).Checked := True; if (Sender <> actGrid_SubNone) then begin F_clSubGridColor := TComponent(Sender).Tag; end; DrawNow; end; procedure TApp_Puffbits.actGrid_SelColorExecute(Sender: TObject); //グリッド色選択 var l_Action: TAction; lb_Shift, lb_Ctrl, lb_Disp: Boolean; begin TAction(Sender).Checked := True; if (actCustom_Setting.Tag = 1) then begin //App_BugsEyeSetting作成時 Exit; end; if (Sender = actGrid_SelColor) then begin l_Action := actGrid_SelColor; end else if (Sender = actGrid_SelSubColor) then begin l_Action := actGrid_SelSubColor; end else begin Exit; end; lb_Shift := gfnbKeyState(VK_SHIFT); lb_Ctrl := gfnbKeyState(VK_CONTROL); lb_Disp := False; if (lb_Ctrl) then begin //画面の色をグリッド色にセット l_Action.Tag := F_rDispInfo.clColorRef; end else if (lb_Shift) then begin //画面の反転色をグリッド色にセット l_Action.Tag := gfnclColorRevers(F_rDispInfo.clColorRef); end else begin ColorDialog.Color := TColor(l_Action.Tag); if (ColorDialog.Execute) then begin l_Action.Tag := ColorDialog.Color; lb_Disp := True; end; end; if (Sender = actGrid_SelColor) then begin F_clGridColor := l_Action.Tag; end else if (Sender = actGrid_SelSubColor) then begin F_clSubGridColor := l_Action.Tag; end; //グリッドが非表示なら表示させる actGrid_Disp.Checked := actGrid_Disp.Checked or lb_Shift or lb_Ctrl or lb_Disp; FormResize(nil); end; //------------------------------------------------------------------------------ //ユーザー指定座標の原点指定 procedure TApp_Puffbits.actPos_UserPosSetExecute(Sender: TObject); {Ctrl,Shift+Ctrl} begin if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin //Shift+Ctrl+Spaceで(0, 0)にリセット F_rDispInfo.ptUserPos := Point(0, 0); end else if (gfnbKeyState(VK_CONTROL)) then begin //ユーザー指定座標の原点へカーソルを移動 MoveCursorToPoint(actPos_UserPosSet); end else begin if (actCapture_Pause.Checked) and not(gfnbKeyState(VK_SHIFT)) then begin F_rDispInfo.ptUserPos := F_rDispInfo.ptMousePos end else begin F_rDispInfo.ptUserPos := gfnptMousePosGet; if not(actPos_User.Checked) then begin actPos_User.Checked := True; FormResize(nil); end; end; end; DrawNow; end; //------------------------------------------------------------------------------ //常に手前に表示 procedure TApp_Puffbits.actOpt_StayOnTopExecute(Sender: TObject); procedure lpc_TopMost(AForm: TForm; bTopMost: Boolean); var lh_InsertAfter: HWND; li_Flag: UINT; begin // if (IsWindowVisible(AForm.Handle)) then begin NG! if (actOpt_StayOnTop.Checked) then begin lh_InsertAfter := HWND_TOPMOST; end else begin lh_InsertAfter := HWND_NOTOPMOST; end; li_Flag := SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE; Windows.SetWindowPos(AForm.Handle, lh_InsertAfter, 0, 0, 0, 0, li_Flag); // end; end; var i: Integer; l_Form: TForm; l_List: TList; begin if (Sender <> nil) then begin actOpt_StayOnTop.Checked := not(actOpt_StayOnTop.Checked); end; l_List := TList.Create; try for i := 0 to Screen.FormCount-1 do begin l_Form := Screen.Forms[i]; if (l_Form = App_Puffbits) or (l_Form = App_PuffbitsSetting) or (l_Form = App_CustomShortCut) then begin l_List.Add(l_Form); end; end; for i := l_List.Count-1 downto 0 do begin lpc_TopMost(TForm(l_List.Items[i]), actOpt_StayOnTop.Checked); end; finally l_List.Free; end; DrawNow; end; //フォントサイズ procedure TApp_Puffbits.actOpt_BigFontExecute(Sender: TObject); begin with F_bmpZoom.Canvas do begin if (actOpt_BigFont.Checked) then begin Font.Size := actOpt_BigFont.Tag; end else begin Font.Size := 9; end; F_iFontHeight := Trunc(TextHeight('A') * 1.2) +1; //ラインを引くため下に1ピクセル余裕を持たせる F_iInfoLeft := F_iFontHeight + TextWidth(Format(F_GetDispFmt(G_ciFMTZOOM), [F_iZoom])) + 4; //4ピクセル離す F_iVLine := TextWidth('COLORREF') + (TextWidth(' ') div 2); end; FormResize(nil); end; procedure TApp_Puffbits.actOpt_NoSelfCaptureExecute(Sender: TObject); //自分自身をキャプチャしない begin if not(gfnbIsAlphaBlendReady) then begin actOpt_NoSelfCapture.Checked := False; AlphaBlend := False; Exit; end; FCheckAeroThemeEnabled(actOpt_NoSelfCapture); AlphaBlend := (mniOpt_NoSelfCapture.Visible and actOpt_NoSelfCapture.Checked); ToolBar_Main.DoubleBuffered := AlphaBlend; Sleep(100); //少し経ってからでないと最初の一度だけうまくキャプチャできない DrawNow; end; (* var ls_OSName: WideString; begin ls_OSName := gfnsOsNameGet; if not(G_bIsNtOS) or (ls_OSName = 'NT') then begin actOpt_NoSelfCapture.Checked := False; AlphaBlend := False; Exit; end; AlphaBlend := (mniOpt_NoSelfCapture.Visible and actOpt_NoSelfCapture.Checked); ToolBar_Main.DoubleBuffered := AlphaBlend; Sleep(100); //少し経ってからでないと最初の一度だけうまくキャプチャできない DrawNow; end; *) //------------------------------------------------------------------------------ //定点キャプチャ、一時停止の文字列を一定時間表示した後元に戻す procedure TApp_Puffbits.Timer_InfomationTimer(Sender: TObject); begin F_sInfomation := ''; Timer_Infomation.Enabled := False; DrawNow; end; //一時停止 procedure TApp_Puffbits.actCapture_PauseExecute(Sender: TObject); var ldc_Desktop : HDC; // lrc_Test : TRect; // li_Ret : Integer; begin if (gfnbKeyState(VK_CONTROL)) then begin MoveCursorToPoint(Sender); Exit; end else if (gfnbKeyState(VK_SHIFT)) then begin F_SetPoint; Exit; end; if (Sender <> actCapture_Update) then begin actCapture_Pause.Checked := not(actCapture_Pause.Checked); end; actCapture_Update.Enabled := actCapture_Pause.Checked; Timer_Main.Enabled := not(actCapture_Pause.Checked); if (actCapture_Pause.Checked) then begin actCapture_Pause.Tag := 1; DrawNow; //↓の処理に少し時間がかかるため先に一時停止の状態表示にする。 // MyCashDesktop.Reflesh; MyScreenSize.Reflesh; //li_Ret := GetRgnBox(MyScreenSize.DesktopRegion, lrc_Test); if not(actOpt_NoSelfCapture.Checked) then begin AlphaBlend := True; end; //全ウィンドウの情報をリストに保持 FWinList := T_WinList.Create; ldc_Desktop := CreateDC('DISPLAY', nil, nil, nil); try with F_bmpDesktop do begin //マルチモニターも含めたデスクトップ全部のキャプチャ //自身も含む { Width := MyCashDesktop.ScreenWidth; Height := MyCashDesktop.ScreenHeight; Canvas.FillRect(Rect(0, 0, Width, Height)); Windows.BitBlt(Canvas.Handle, 0, 0, MyCashDesktop.ScreenWidth, MyCashDesktop.ScreenHeight, ldc_Desktop, MyCashDesktop.ScreenLeft, MyCashDesktop.ScreenTop, SRCCOPY or CAPTUREBLT); } Width := MyScreenSize.ScreenWidth; Height := MyScreenSize.ScreenHeight; Canvas.FillRect(Rect(0, 0, Width, Height)); Windows.BitBlt(Canvas.Handle, 0, 0, MyScreenSize.ScreenWidth, MyScreenSize.ScreenHeight, ldc_Desktop, MyScreenSize.ScreenLeft, MyScreenSize.ScreenTop, SRCCOPY or CAPTUREBLT); end; with F_bmpNoSelf do begin //マルチモニターも含めたデスクトップ全部のキャプチャ //自身は含まない { Width := MyCashDesktop.ScreenWidth; Height := MyCashDesktop.ScreenHeight; Canvas.FillRect(Rect(0, 0, Width, Height)); Windows.BitBlt(Canvas.Handle, 0, 0, MyCashDesktop.ScreenWidth, MyCashDesktop.ScreenHeight, ldc_Desktop, MyCashDesktop.ScreenLeft, MyCashDesktop.ScreenTop, SRCCOPY); } Width := MyScreenSize.ScreenWidth; Height := MyScreenSize.ScreenHeight; Canvas.FillRect(Rect(0, 0, Width, Height)); Windows.BitBlt(Canvas.Handle, 0, 0, MyScreenSize.ScreenWidth, MyScreenSize.ScreenHeight, ldc_Desktop, MyScreenSize.ScreenLeft, MyScreenSize.ScreenTop, SRCCOPY); end; finally DeleteDC(ldc_Desktop); end; if not(actOpt_NoSelfCapture.Checked) then begin AlphaBlend := False; end; actCapture_Pause.Tag := 0; end else begin MyScreenSize.Reflesh; //一時停止中にモニター情報が変わったかもしれないので更新する FWinList.Free; //リストを解放 FWinList := nil; if (F_iZoomBak > 0) then begin F_iZoom := F_iZoomBak; F_iZoomBak := -1; end; end; FCheckAeroThemeEnabled(nil); pnlCapture.Visible := (actCapture_Fixed.Checked or actCapture_Pause.Checked); Timer_InfomationTimer(Sender); FormResize(nil); DrawNow; end; procedure TApp_Puffbits.actCapture_UpdateExecute(Sender: TObject); //更新 begin // if not(actCapture_Pause.Checked) then begin Exit; end; actCapture_PauseExecute(actCapture_Update); end; //定点キャプチャ procedure TApp_Puffbits.actCapture_FixedExecute(Sender: TObject); {Shift,Ctrl} //マウスカーソルに追従せず、一点をキャプチャし続ける begin if (gfnbKeyState(VK_CONTROL)) then begin MoveCursorToPoint(Sender); Exit; end else if (gfnbKeyState(VK_SHIFT)) then begin F_SetPoint; Exit; end; actCapture_Fixed.Checked := not(actCapture_Fixed.Checked); F_rDispInfo.ptMousePos := gfnptMousePosGet; pnlCapture.Visible := (actCapture_Fixed.Checked or actCapture_Pause.Checked); Timer_InfomationTimer(Sender); DrawNow; end; //スムースキャプチャ procedure TApp_Puffbits.actOpt_SmoothCaptureExecute(Sender: TObject); //マウスカーソルを動かしていない時でもキャプチャを間引かない const lci_SMOOTH = 30; lci_NORMAL = 60; begin if (actOpt_SmoothCapture.Checked) then begin Timer_Main.Interval := lci_SMOOTH; end else begin Timer_Main.Interval := lci_NORMAL; end; if (Sender <> nil) then begin Timer_InfomationTimer(Sender); end; DrawNow end; function TApp_Puffbits.F_GetDispFmt(iIndex: Integer): String; //表示用形式文字列を返す begin if (iIndex < 0) or (iIndex > G_ciFMTCOUNT) then begin Result := ''; end else begin Result := G_csDISPFMT[iIndex]; end; end; function TApp_Puffbits.F_GetCopyFmt(iIndex: Integer): String; //コピー用形式文字列を返す begin if (iIndex < 0) or (iIndex > G_ciFMTCOUNT) then begin Result := ''; end else begin if (gfnbKeyState(VK_SHIFT)) then begin Result := G_csCOPYFMT[iIndex, 1]; end else begin Result := G_csCOPYFMT[iIndex, 0]; end; end; end; function TApp_Puffbits.F_GetCopyZoomGrid: Boolean; //グリッドも含めコピーするか begin if (gfnbKeyState(VK_SHIFT)) then begin Result := (Copy(G_csCOPYFMT[G_ciFMTZOOM, 1], 1, 1) <> '0'); //10の位 end else begin Result := (Copy(G_csCOPYFMT[G_ciFMTZOOM, 0], 1, 1) <> '0'); //10の位 end; end; procedure TApp_Puffbits.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //キーを押している間だけ倍率を1倍にする var i: Integer; l_Action: TAction; begin if (ssAlt in Shift) then begin Exit; end; //------------------------------------------------------------------------------ //準汎用フォーム用 for i := 0 to G_ShortCutList.Count-1 do begin if (Key = T_ShortCutAction(G_ShortCutList.Items[i]).Key) then begin l_Action := T_ShortCutAction(G_ShortCutList.Items[i]).Action; if (l_Action = actMove_Up) or (l_Action = actMove_Down) or (l_Action = actMove_Left) or (l_Action = actMove_Right) then begin l_Action.OnExecute(l_Action); end else if (l_Action = actCapture_Disp_x1) // and (actCapture_Pause.Checked or actCapture_Fixed.Checked) and (F_iZoomBak < 0) then begin //キーを押している間だけ倍率を1倍にする F_iZoomBak := F_iZoom; F_iZoom := 1; F_iPassTime := 0; FormResize(nil); end; Key := 0; Exit; end; end; end; //------------------------------------------------------------------------------ { var li_Key: Word; l_Shift: TShiftState; begin if (actCapture_Disp_x1.SecondaryShortCuts.Count = 0) then Exit; ShortCutToKey(actCapture_Disp_x1.SecondaryShortCuts.ShortCuts[0], li_Key, l_Shift); if (actCapture_Pause.Checked or actCapture_Fixed.Checked) and (F_iZoomBak < 0) and (Key = li_Key) then begin // F_Capture_KeyDown; F_iZoomBak := F_iZoom; F_iZoom := 1; F_iPassTime := 0; FormResize(nil); end; end; } procedure TApp_Puffbits.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var i: Integer; l_Action: TAction; begin //------------------------------------------------------------------------------ //準汎用フォーム用 if (Key = VK_APPS) then begin actMenu_MainExecute(nil); Key := 0; end else begin if not(ssAlt in Shift) then begin for i := 0 to G_ShortCutList.Count-1 do begin if (Key = T_ShortCutAction(G_ShortCutList.Items[i]).Key) then begin l_Action := T_ShortCutAction(G_ShortCutList.Items[i]).Action; if (l_Action = actMove_Up) or (l_Action = actMove_Down) or (l_Action = actMove_Left) or (l_Action = actMove_Right) then begin //KeyDownで処理済なのでここでは何もしない end else if (l_Action = actCapture_Disp_x1) then begin F_Capture_KeyUp; end else begin if (l_Action.AutoCheck) then begin l_Action.Checked := not(l_Action.Checked); end; l_Action.OnExecute(l_Action); end; Key := 0; Exit; end; end; end; end; //------------------------------------------------------------------------------ end; { var li_Key: Word; l_Shift: TShiftState; begin if (actCapture_Disp_x1.SecondaryShortCuts.Count = 0) then Exit; ShortCutToKey(actCapture_Disp_x1.SecondaryShortCuts.ShortCuts[0], li_Key, l_Shift); if (Key = li_Key) then begin F_Capture_KeyUp; end; end; } procedure TApp_Puffbits.F_Capture_KeyUp; //↑を元に戻す begin if (F_iZoomBak > 0) then begin F_iZoom := F_iZoomBak; F_iZoomBak := -1; F_iPassTime := 0; FormResize(nil); end; end; procedure TApp_Puffbits.F_Capture_MovePoint(ptPos: TPoint); const lci_Threshold = 5; lci_Wait = 40; var i, li_Start, li_Time: DWORD; begin if ((Abs(ptPos.X - F_rDispInfo.ptMousePos.X) > lci_Threshold) or (Abs(ptPos.Y - F_rDispInfo.ptMousePos.Y) > lci_Threshold)) then begin //移動をアニメーション li_Start := Windows.GetTickCount; for i := 1 to lci_Threshold -1 do begin F_rDispInfo.ptMousePos := Point( F_rDispInfo.ptMousePos.X + gfniRound(((ptPos.X - F_rDispInfo.ptMousePos.X) / lci_Threshold) * i), F_rDispInfo.ptMousePos.Y + gfniRound(((ptPos.Y - F_rDispInfo.ptMousePos.Y) / lci_Threshold) * i) ); DrawNow; li_Time := Windows.GetTickCount; if (li_Start + (i * lci_Wait) > li_Time) then begin Windows.Sleep(li_Start + (i * lci_Wait) - li_Time); end; end; end; F_rDispInfo.ptMousePos := ptPos; Timer_InfomationTimer(nil); DrawNow; end; //一時停止中にダブルクリックした点をキャプチャポジションにする procedure TApp_Puffbits.FormDblClick(Sender: TObject); var lpt_Pos : TPoint; lr_Monitor : TMyMonitorPos; begin if (actCapture_Pause.Checked) or (actCapture_Fixed.Checked) then begin lpt_Pos := Point( gfniNumLimit(F_rDispInfo.ptMousePos.X + (F_ptDragClientPos.X - F_iRulerWidth) div F_iZoom - F_szDesktop.Left, MyScreenSize.ScreenLeft, MyScreenSize.ScreenWidth -1), gfniNumLimit(F_rDispInfo.ptMousePos.Y + (F_ptDragClientPos.Y - F_iRulerWidth - ToolBar_Main.Height) div F_iZoom - F_szDesktop.Top, MyScreenSize.ScreenTop, MyScreenSize.ScreenHeight -1) ); lr_Monitor := gfnrScreenToMonitor(MyScreenSize, lpt_Pos); if ((lpt_Pos.X <> F_rDispInfo.ptMousePos.X) or ( lpt_Pos.Y <> F_rDispInfo.ptMousePos.Y)) //前回から動いていて and (lr_Monitor.MonitorNum >= 0) //モニターの範囲内 then begin F_Capture_MovePoint(lpt_Pos); end; end; end; procedure TApp_Puffbits.MoveCursorToPoint(Sender: TObject); //マウスカーソルをキャプチャポイントへ移動 const lci_Threshold = 10; lci_Wait = 10; var i, li_Start, li_Time: DWORD; lpt_Cursor, lpt_Point: TPoint; begin //定点キャプチャ・一時停止時 if (Sender = actPos_UserPosSet) then begin //ユーザー指定の原点 lpt_Point := F_rDispInfo.ptUserPos; end else if (actCapture_Fixed.Checked) or (actCapture_Pause.Checked) then begin //一時停止か定点キャプチャ時 lpt_Point := F_rDispInfo.ptMousePos; end else begin //それ以外の場合はあまり意味がないので処理を抜ける Exit; end; lpt_Cursor := gfnptMousePosGet; if (Abs(lpt_Cursor.X - lpt_Point.X) > lci_Threshold) or (Abs(lpt_Cursor.Y - lpt_Point.Y) > lci_Threshold) then begin //カーソルを瞬時に移動させるのではなく残像を見せつつ移動させる li_Start := Windows.GetTickCount; for i := 1 to lci_Threshold -1 do begin Windows.SetCursorPos( lpt_Cursor.X - gfniRound(((lpt_Cursor.X - lpt_Point.X) / lci_Threshold) * i), lpt_Cursor.Y - gfniRound(((lpt_Cursor.Y - lpt_Point.Y) / lci_Threshold) * i) ); li_Time := Windows.GetTickCount; if (li_Start + (i * lci_Wait) > li_Time) then begin Windows.Sleep(li_Start + (i * lci_Wait) - li_Time); end; end; end; Windows.SetCursorPos(lpt_Point.X, lpt_Point.Y); end; procedure TApp_Puffbits.F_SetPoint; //現在のマウスカーソルの位置をキャプチャポイントに設定 begin //定点キャプチャ・一時停止時 if (actCapture_Fixed.Checked) or (actCapture_Pause.Checked) then begin F_Capture_MovePoint(gfnptMousePosGet); end; end; //------------------------------------------------------------------------------ //最小化 procedure TApp_Puffbits.actFile_MinimizeExecute(Sender: TObject); begin Application.Minimize; end; //終了 procedure TApp_Puffbits.actFile_ExitExecute(Sender: TObject); begin Close; end; //============================================================================== procedure TApp_Puffbits.F_PushInfomation(sText: WideString); //1行情報表示へ情報をプッシュ begin F_sInfomation := sText; Timer_Infomation.Enabled := True; DrawNow; end; (* //ptPosの点上にある可視ウィンドウを返す。 type T_TopWindow = record hTop, hParent: HWND; end; P_TopWindow = ^T_TopWindow; function lfnb_EnumChildProc(hHandle: HWND; pTopWindow: Pointer): BOOL; stdcall; var lh_Parent: HWND; begin Result := True; with App_Puffbits do begin if (IsWindowVisible(hHandle)) and (PtInRect(gfnrcWindowRectGet(hHandle), F_rDispInfo.ptMousePos)) then begin lh_Parent := gfnhParentWindowGet(hHandle); if (lh_Parent = T_TopWindow(pTopWindow^).hTop) then begin //直前に列挙された対象ウィンドウの子ウィンドウだった //hTopとhParentを書き換える //子ウィンドウがあるかもしれないので処理を続ける T_TopWindow(pTopWindow^).hTop := hHandle; T_TopWindow(pTopWindow^).hParent := lh_Parent; end else begin //親ウィンドウが同じなら兄弟ウィンドウ。 //しかし列挙されるのは手前のウィンドウからなのでその場合はhTopは書き換ず処理を抜ける。 //親ウィンドウが直前のウィンドウでもない //おじさんおばさんウィンドウ、あるいはさらに遡ってのウィンドウであるのでこれまたhTopを書き換えず処理を抜ける Result := False; end; end; end; end; function lfnb_EnumWindowsProc(hHandle: HWND; pTopWindow: Pointer):BOOL; stdcall; //トップレベルウィンドウを列挙する var lrg_Region: HRGN; lpt_Pos: TPoint; lrc_Rect, lrc_Client: TRect; begin with App_Puffbits do begin lrc_Rect := gfnrcWindowRectGet(hHandle); if (IsWindowVisible(hHandle)) //可視ウィンドウのみ and (PtInRect(lrc_Rect, F_rDispInfo.ptMousePos)) //ウィンドウのRect内にマウスカーソルがある then begin if (actOpt_NoSelfCapture.Checked) and (actOpt_NoSelfCapture.Enabled) and ((GetWindowLong(hHandle, GWL_EXSTYLE) and WS_EX_LAYERED) = WS_EX_LAYERED) then begin //自身をキャプチャしない設定で対象ウィンドウがレイヤードである場合キャプチャできていないので次のウィンドウに処理を移す Result := True; end else begin Result := False; lrg_Region := CreateRectRgn(0, 0, 0, 0); try if (GetWindowRgn(hHandle, lrg_Region) <> ERROR) then begin lpt_Pos.X := F_rDispInfo.ptMousePos.X - lrc_Rect.Left; lpt_Pos.Y := F_rDispInfo.ptMousePos.Y - lrc_Rect.Top; if (PtInRegion(lrg_Region, lpt_Pos.X, lpt_Pos.Y)) then begin //リージョン内だったので処理を抜ける end else begin //リージョン外だったので処理を続ける Result := True; end; end; finally DeleteObject(lrg_Region); end; if (Result = False) then begin T_TopWindow(pTopWindow^).hTop := hHandle; T_TopWindow(pTopWindow^).hParent := gfnhParentWindowGet(hHandle); lrc_Client := gfnrcClientRectGet(hHandle); if (lrc_Client.Right > 0) or (lrc_Client.Bottom > 0) then begin EnumChildWindows(hHandle, @lfnb_EnumChildProc, LPARAM(pTopWindow)); end; end; end; end else begin Result := True; end; end; end; function TApp_Puffbits.F_GetWindow(ptPos: TPoint): HWND; var lr_TopWindow: T_TopWindow; lh_Handle: HWND; begin { //レイヤードウィンドウの下にEnabledがFalseのウィンドウやVisibleがFalseのウィンド //ウがあるとおかしなことになるのでコメントアウト //EnumWindowsでレイヤードウィンドウを正しく扱えないための齟齬が生じるのが原因。 lh_Handle := WindowFromPoint(ptPos); if not(App_BugsEye.mniOpt_NoSelfCapture.Visible and App_BugsEye.actOpt_NoSelfCapture.Checked) then begin //XPスタイルの角の丸いタイトルバーも正しく処理できる if (lh_Handle = ChildWindowFromPoint(lh_Handle, gfnptScreenToClient(lh_Handle, ptPos))) then begin //WindowFromPoint関数とChildWindowFromPoint関数で同じハンドルが返ってくるのであればそれで良い。 Result := lh_Handle; Exit; end; end; } if (mniOpt_NoSelfCapture.Visible) and (actOpt_NoSelfCapture.Checked) and (actOpt_NoSelfCapture.Enabled) then begin //自身をキャプチャしない FillChar(lr_TopWindow, SizeOf(lr_TopWindow), 0); EnumWindows(@lfnb_EnumWindowsProc, LPARAM(@lr_TopWindow)); Result := lr_TopWindow.hTop; end else begin lh_Handle := WindowFromPoint(ptPos); if (lh_Handle = ChildWindowFromPoint(lh_Handle, gfnptScreenToClient(lh_Handle, ptPos))) then begin Result := lh_Handle; end else begin //レイヤードウィンドウで下のウィンドウが透過するウィンドウは正しく処理できない //XPスタイルの角の丸いタイトルバーはOK FillChar(lr_TopWindow, SizeOf(lr_TopWindow), 0); EnumWindows(@lfnb_EnumWindowsProc, LPARAM(@lr_TopWindow)); Result := lr_TopWindow.hTop; end; end; end; *) function TApp_Puffbits.F_GetWindow(ptPos: TPoint): HWND; //ptPosの点上にある可視ウィンドウを返す。 type T_TopWindow = record hTop : HWND; pPoint : TPoint; bNoSelfCapture : Boolean; end; P_TopWindow = ^T_TopWindow; function lfnb_EnumChildProc(hHandle: HWND; pTopWindow: Pointer): BOOL; stdcall; var lh_Parent: HWND; begin Result := True; if (IsWindowVisible(hHandle)) // and (PtInRect(gfnrcWindowRectGet(hHandle), FrDispInfo.ptMousePos)) and (PtInRect(gfnrcWindowRectGet(hHandle), T_TopWindow(pTopWindow^).pPoint)) then begin lh_Parent := gfnhParentWindowGet(hHandle); if (lh_Parent = T_TopWindow(pTopWindow^).hTop) then begin //直前に列挙された対象ウィンドウの子ウィンドウだった //hTopとhParentを書き換える //子ウィンドウがあるかもしれないので処理を続ける T_TopWindow(pTopWindow^).hTop := hHandle; // T_TopWindow(pTopWindow^).hParent := lh_Parent; end else begin //親ウィンドウが同じなら兄弟ウィンドウ。 //しかし列挙されるのは手前のウィンドウからなのでその場合はhTopは書き換ず処理を抜ける。 //親ウィンドウが直前のウィンドウでもない //おじさんおばさんウィンドウ、あるいはさらに遡ってのウィンドウであるのでこれまたhTopを書き換えず処理を抜ける Result := False; end; end; end; function _EnumWindowsProc(hHandle: HWND; pTopWindow: Pointer):BOOL; stdcall; //トップレベルウィンドウを列挙する var lrg_Region: HRGN; lpt_Pos: TPoint; lrc_Rect, lrc_Client: TRect; begin lrc_Rect := gfnrcWindowRectGet(hHandle); if (IsWindowVisible(hHandle)) //可視ウィンドウのみ // and (PtInRect(lrc_Rect, FrDispInfo.ptMousePos)) //ウィンドウのRect内にマウスカーソルがある and (PtInRect(lrc_Rect, T_TopWindow(pTopWindow^).pPoint)) //ウィンドウのRect内にマウスカーソルがある then begin if (T_TopWindow(pTopWindow^).bNoSelfCapture) and ((GetWindowLong(hHandle, GWL_EXSTYLE) and WS_EX_LAYERED) = WS_EX_LAYERED) then begin //自身をキャプチャしない設定で対象ウィンドウがレイヤードである場合キャプチャできていないので次のウィンドウに処理を移す Result := True; end else begin Result := False; lrg_Region := CreateRectRgn(0, 0, 0, 0); try if (GetWindowRgn(hHandle, lrg_Region) <> ERROR) then begin lpt_Pos.X := T_TopWindow(pTopWindow^).pPoint.X - lrc_Rect.Left; lpt_Pos.Y := T_TopWindow(pTopWindow^).pPoint.Y - lrc_Rect.Top; if (PtInRegion(lrg_Region, lpt_Pos.X, lpt_Pos.Y)) then begin //リージョン内だったので処理を抜ける end else begin //リージョン外だったので処理を続ける Result := True; end; end; finally DeleteObject(lrg_Region); end; if (Result = False) then begin T_TopWindow(pTopWindow^).hTop := hHandle; // T_TopWindow(pTopWindow^).hParent := gfnhParentWindowGet(hHandle); lrc_Client := gfnrcClientRectGet(hHandle); if (lrc_Client.Right > 0) or (lrc_Client.Bottom > 0) then begin EnumChildWindows(hHandle, @lfnb_EnumChildProc, LPARAM(pTopWindow)); end; end; end; end else begin Result := True; end; end; var lr_TopWindow : T_TopWindow; lh_Toplevel : HWND; //lh_Handle2のトップレベルウィンドウ li_ExStyle : DWORD; li_ColorKey : COLORREF; li_Alpha : BYTE; li_Flag : DWORD; begin if (actOpt_NoSelfCapture.Checked) then begin //自身をキャプチャしない FillChar(lr_TopWindow, SizeOf(lr_TopWindow), 0); lr_TopWindow.pPoint := ptPos; lr_TopWindow.bNoSelfCapture := True; EnumWindows(@_EnumWindowsProc, LPARAM(@lr_TopWindow)); Result := lr_TopWindow.hTop; end else begin Result := WindowFromPoint(ptPos); { if (Result = ChildWindowFromPoint(Result, gfnptScreenToClient(Result, ptPos))) then begin Exit; end; } //レイヤードウィンドウで下のウィンドウが透過するウィンドウは正しく処理できない。 //XPスタイルの角の丸いタイトルバーはOK。 FillChar(lr_TopWindow, SizeOf(lr_TopWindow), 0); lr_TopWindow.pPoint := ptPos; EnumWindows(@_EnumWindowsProc, LPARAM(@lr_TopWindow)); //WindowFromPoint APIで取得したハンドルとEnumWindows APIで取得したハンドルを比較する。 if (Result <> lr_TopWindow.hTop) then begin //違っていたらEnumWindows APIで取得したウィンドウのスタイルを調べる。 //WS_EX_TRANSPARENTとWS_EX_LAYEREDが同時にセットされていたら見えていても //WindowFromPoint APIでは取得できないウィンドウなのでこちらを返す。 lh_Toplevel := GetAncestor(lr_TopWindow.hTop, GA_ROOT); li_ExStyle := GetWindowLong(lh_Toplevel, GWL_EXSTYLE); if ((li_ExStyle and WS_EX_LAYERED) = WS_EX_LAYERED) and ((li_ExStyle and WS_EX_TRANSPARENT) = WS_EX_TRANSPARENT) then begin if (gfnbGetLayeredWindowAttributes(lh_Toplevel, li_ColorKey, li_Alpha, li_Flag)) then begin if ((li_Flag and LWA_ALPHA) = LWA_ALPHA) and (li_Alpha = 0) then begin Exit; end; end; end; Result := lr_TopWindow.hTop; end; end; end; procedure TApp_Puffbits.Timer_MainTimer(Sender: TObject); const //情報表示欄に引くラインのマージン。どれだけ文字から離すか lci_LINEMARGIN = 2; lci_MARGINLEFT = 2; const //ステータス表示の位置(順序) lci_INFO_STAYONTOP = 0; lci_INFO_SMOOTH = 1; lci_INFO_PAUSE = 2; lci_INFO_FIX = 3; const lci_SUBGRID = 5; //サブグリッドの間隔 lci_SUBELSEGRID = 2; //サブグリッドを違う色で引く間隔 lci_GRIDMARGIN = 1; //倍率が低いときのグリッドとカーソルポイントとの間隔 var lpt_Pos: TPoint; li_TickCount: DWORD; ldc_Pause, ldc_Desktop: HDC; l_Item: T_WinItem; lcl_BackColor: TColor; lrc_Rect: TRect; i, li_Width, li_Height, li_BoxLen, li_ShiftLine: Integer; li_Rop: DWORD; begin // Application.ProcessMessages; if (Application.Terminated) then begin Timer_Main.Enabled := False; Exit; end; if (F_bThroughTimer) then begin Exit; end; F_bThroughTimer := True; if ((actCapture_Fixed.Checked) or (actCapture_Pause.Checked)) then begin lpt_Pos := F_rDispInfo.ptMousePos; //固定キャプチャ end else begin Windows.GetCursorPos(lpt_Pos); end; li_TickCount := Windows.GetTickCount; if (lpt_Pos.X <> F_rDispInfo.ptMousePos.X) or (lpt_Pos.Y <> F_rDispInfo.ptMousePos.Y) //前回表示の時と今回とマウスカーソルの位置が違っている or (F_iPassTime = 0) //経過時間が0である or (Abs(li_TickCount - F_iPassTime) > Timer_Main.Tag) //前回描画時からリフレッシュ時間を過ぎている。 or (actOpt_SmoothCapture.Checked) //スムーズキャプチャ（間引き無し） then begin //上記のどれかに合致したらば↓の処理に入る with F_rDispInfo, F_bmpZoom.Canvas do begin ptMousePos := lpt_Pos; Brush.Color := clBlack; FillRect(Rect(F_iRulerWidth, F_iRulerWidth, ClientWidth, F_rcInfo.Top)); if (Timer_Main.Enabled = False) and (actCapture_Pause.Tag = 0) //actCapture_Pause.Tagが1の時はキャッシュを使わない then begin //一時停止とズーム画像コピーのとき if (actOpt_NoSelfCapture.Checked) and (actOpt_NoSelfCapture.Enabled) then begin ldc_Pause := F_bmpNoSelf.Canvas.Handle; end else begin ldc_Pause := F_bmpDesktop.Canvas.Handle; end; Windows.StretchBlt( Handle, F_iRulerWidth, F_iRulerWidth, F_szZoom.Width, F_szZoom.Height, ldc_Pause, // ptMousePos.X - F_szDesktop.Left - MyCashDesktop.ScreenLeft, // ptMousePos.Y - F_szDesktop.Top - MyCashDesktop.ScreenTop, ptMousePos.X - F_szDesktop.Left - MyScreenSize.ScreenLeft, ptMousePos.Y - F_szDesktop.Top - MyScreenSize.ScreenTop, F_szDesktop.Width, F_szDesktop.Height, SRCCOPY ); end else begin //リアルタイムのデスクトップをキャプチャ ldc_Desktop := CreateDC('DISPLAY', nil, nil, nil); try if (actOpt_NoSelfCapture.Checked) and (actOpt_NoSelfCapture.Enabled) then begin li_Rop := SRCCOPY; end else begin li_Rop := SRCCOPY or CAPTUREBLT; end; //レイヤードウィンドウはStretchBltでは拡大コピーできないようなので一度等倍でコピーしてから拡大する F_bmpDesktop.Canvas.Brush.Color := clBlack; F_bmpDesktop.Canvas.FillRect(Rect(0, 0, F_szDesktop.Width, F_szDesktop.Height)); BitBlt(F_bmpDesktop.Canvas.Handle, 0, 0, F_szDesktop.Width, F_szDesktop.Height, ldc_Desktop, ptMousePos.X - F_szDesktop.Left, ptMousePos.Y - F_szDesktop.Top, li_Rop); StretchBlt(Handle, F_iRulerWidth, F_iRulerWidth, F_szZoom.Width, F_szZoom.Height, F_bmpDesktop.Canvas.Handle, 0, 0, F_szDesktop.Width, F_szDesktop.Height, SRCCOPY); // StretchBlt(Handle, F_iRulerWidth, F_iRulerWidth, F_szZoom.Width, F_szZoom.Height, ldc_Desktop, ptMousePos.X - F_szDesktop.Left, ptMousePos.Y - F_szDesktop.Top, F_szDesktop.Width, F_szDesktop.Height, li_Rop); finally DeleteDC(ldc_Desktop); end; end; //グリッド描画 if (actGrid_Disp.Checked) then begin if (F_iZoom >= FciMINGRID) then begin //ペンをセット Pen.Color := F_clGridColor; Pen.Mode := F_pmPenMode; //縦線を引く for i := 0 to F_iHGrid do begin li_Width := i * F_iZoom + F_iRulerWidth; MoveTo(li_Width, F_iRulerWidth); LineTo(li_Width, F_rcInfo.Top); end; //横線を引く for i := 0 to F_iVGrid do begin li_Height := i * F_iZoom + F_iRulerWidth; MoveTo(F_iRulerWidth, li_Height); LineTo(ClientWidth, li_Height); end; //サブグリッドを引く if not(actGrid_SubNone.Checked) then begin Pen.Color := F_clSubGridColor; Pen.Mode := pmCopy; //縦線を引く //キャプチャポイントを中心にしてサブグリッドを引くため li_ShiftLine := ((gfniRound(F_iHGrid / 2) -1) mod lci_SUBGRID) * F_iZoom; for i := 0 to F_iHGrid div lci_SUBGRID do begin li_Width := F_iRulerWidth + li_ShiftLine + (i * F_iZoom * lci_SUBGRID); MoveTo(li_Width, F_iRulerWidth); LineTo(li_Width, F_rcInfo.Top); end; //横線を引く //キャプチャポイントを中心にしてサブグリッドを引くため li_ShiftLine := ((gfniRound(F_iVGrid / 2) -1) mod lci_SUBGRID) * F_iZoom; for i := 0 to F_iVGrid div lci_SUBGRID do begin li_Height := F_iRulerWidth + li_ShiftLine + (i * F_iZoom * lci_SUBGRID); MoveTo(F_iRulerWidth, li_Height); LineTo(ClientWidth, li_Height); end; end; end else begin //倍率が低くてグリッドを引けないのでキャプチャポイントのグリッドだけ引く //枠線を引く //ペンをセット Pen.Color := F_clGridColor; Pen.Mode := F_pmPenMode; //縦線を引く li_Width := F_iRulerWidth; MoveTo(li_Width, F_iRulerWidth); LineTo(li_Width, F_rcInfo.Top); //横線を引く li_Height := F_iRulerWidth; MoveTo(F_iRulerWidth, li_Height); LineTo(ClientWidth, li_Height); //中心線を引く if not(actGrid_SubNone.Checked) then begin //サブグリッドあり Pen.Color := F_clSubGridColor; Pen.Mode := pmCopy; end; //縦線を引く MoveTo(F_ptColorPos.X, F_iRulerWidth); LineTo(F_ptColorPos.X, F_ptColorPos.Y - F_GetPointShift - lci_GRIDMARGIN); MoveTo(F_ptColorPos.X, F_ptColorPos.Y + F_iZoom + F_GetPointShift + lci_GRIDMARGIN); LineTo(F_ptColorPos.X, F_rcInfo.Top); //横線を引く MoveTo(F_iRulerWidth, F_ptColorPos.Y); LineTo(F_ptColorPos.X - F_GetPointShift - lci_GRIDMARGIN, F_ptColorPos.Y); MoveTo(F_ptColorPos.X + F_iZoom + F_GetPointShift + lci_GRIDMARGIN, F_ptColorPos.Y); LineTo(ClientWidth, F_ptColorPos.Y); end; end; //現在のマウスカーソルのポイント表示 li_BoxLen := F_iZoom + F_GetPointShift; Pen.Mode := pmNot; li_Width := F_ptColorPos.X - F_GetPointShift; li_Height := F_ptColorPos.Y - F_GetPointShift; PolyLine([ Point(li_Width , li_Height), Point(li_Width + li_BoxLen, li_Height), //→ Point(li_Width + li_BoxLen, li_Height + li_BoxLen), //↓ Point(li_Width , li_Height + li_BoxLen), //← Point(li_Width , li_Height) //↑ ]); Pen.Mode := pmCopy; //情報表示---------------------------------------------------------------------- //カラー値は表示させていなくてもコピーで使うことがあるのでここに置く clColorRef := Pixels[F_ptColorPos.X, F_ptColorPos.Y]; iRed := clColorRef and $0000FF; iGreen := clColorRef and $00FF00 div $000100; iBlue := clColorRef and $FF0000 div $010000; clColor := (iRed * $010000) + (iGreen * $000100) + iBlue; //マウスポジションの座標変換 if (actCapture_Pause.Checked) and (actCapture_Pause.Tag = 0) //一時停止の始めに時間のかかる処理を行うので、その場合はこの中に入らない then begin //一時停止中は保持しておいたデータの方を参照する l_Item := FWinList.FindWindowItem( ptMousePos, (actOpt_NoSelfCapture.Checked) and (actOpt_NoSelfCapture.Enabled) //9x系とNTはEnabledをFalseにする ); if (l_Item <> nil) then begin hWinHandle := l_Item.Handle; sWinClass := l_Item.WinClassName; sWinText := l_Item.Text; szWindowSize := l_Item.WindowSize; szClientSize := l_Item.ClientSize; ptClientPos := l_Item.ClientPos; rcWinRect := l_Item.BoundsRect; sExeName := l_Item.ExeName; end else begin hWinHandle := 0; sWinClass := ''; sWinText := ''; FillChar(szWindowSize, SizeOf(szWindowSize), 0); FillChar(szClientSize, SizeOf(szClientSize), 0); ptClientPos := Point(0, 0); rcWinRect := Rect(0, 0, 0, 0); sExeName := ''; end; end else begin //表示させていないものでも一時停止時に表示させることができるのでこの位置でセット ptClientPos := ptMousePos; hWinHandle := F_GetWindow(ptMousePos); Windows.ScreenToClient(hWinHandle, ptClientPos); ptClientPos := Point(ptMousePos.X - ptClientPos.X, ptMousePos.Y - ptClientPos.Y); sWinClass := gfnsClassNameGet(hWinHandle); sWinText := gfnsWindowTextGet(hWinHandle); // Windows.GetWindowRect(hWinHandle, lrc_Rect); lrc_Rect := gfnrcWindowRectGet(hWinHandle); rcWinRect := lrc_Rect; // lpt_Pos := lrc_Rect.TopLeft; // Windows.ScreenToClient(gfnhParentWindowGet(hWinHandle), lpt_Pos); // lpt_Pos := gfnptClientPosGet lpt_Pos := gfnptScreenToClient(gfnhParentWindowGet(hWinHandle), lrc_Rect.TopLeft); with szWindowSize do begin Left := lpt_Pos.X; Top := lpt_Pos.Y; Width := lrc_Rect.Right - lrc_Rect.Left; Height := lrc_Rect.Bottom - lrc_Rect.Top; end; Windows.GetClientRect(hWinHandle, lrc_Rect); with szClientSize do begin Width := lrc_Rect.Right; Height := lrc_Rect.Bottom; end; sExeName := gfnsExeNameGet(hWinHandle); end; //以下は各種情報表示 ----------------------------------------------------- //情報表示枠の塗りつぶし if (GetActiveWindow <> Self.Handle) then begin //フォームがアクティブでなければ灰色表示 Brush.Color := clBtnFace; Font.Color := clBtnText; Pen.Color := clBtnShadow; end else if (actCapture_Pause.Checked) then begin //一時停止時はヒントのカラー(薄黄色) Brush.Color := clInfoBk; Font.Color := clInfoText; Pen.Color := clBtnFace; end else begin Brush.Color := clWindow; Font.Color := clWindowText; Pen.Color := clBtnFace; end; FillRect(F_rcInfo); //1行表示(倍率などの表示) li_Height := F_rcInfo.Top + lci_LINEMARGIN; if (F_sInfomation <> '') then begin //1行情報表示 if (G_bIsNtOs) then begin TextOutW(Handle, F_iFontHeight + lci_MARGINLEFT, li_Height, PWideChar(F_sInfomation), Length(F_sInfomation)); //現在のピクセルの色表示を避けるためF_iFontHeightをプラス。 end else begin TextOut(F_iFontHeight + lci_MARGINLEFT, li_Height, F_sInfomation); //現在のピクセルの色表示を避けるためF_iFontHeightをプラス。 end; end else begin TextOut(F_iFontHeight + lci_MARGINLEFT, li_Height, Format(F_GetDispFmt(G_ciFMTZOOM), [F_iZoom])); if (actOpt_StayOnTop.Checked) then ImageList_Icon.Draw(F_bmpZoom.Canvas, F_iInfoLeft + ImageList_Icon.Width * lci_INFO_STAYONTOP, li_Height -1, lci_INFO_STAYONTOP); //StayOnTop if (actCapture_Pause.Checked) then ImageList_Icon.Draw(F_bmpZoom.Canvas, F_iInfoLeft + ImageList_Icon.Width * lci_INFO_PAUSE, li_Height -1, lci_INFO_PAUSE); //Pause if (actOpt_SmoothCapture.Checked) then ImageList_Icon.Draw(F_bmpZoom.Canvas, F_iInfoLeft + ImageList_Icon.Width * lci_INFO_SMOOTH, li_Height -1, lci_INFO_SMOOTH); //Smooth if (actCapture_Fixed.Checked) then begin ImageList_Icon.Draw(F_bmpZoom.Canvas, F_iInfoLeft + ImageList_Icon.Width * lci_INFO_FIX, li_Height -1, lci_INFO_FIX); //Fix TextOut(F_iInfoLeft + ImageList_Icon.Width * ImageList_Icon.Count, li_Height, Format(lcsMARK_Fixed, [F_rDispInfo.ptMousePos.X, F_rDispInfo.ptMousePos.Y])); end; end; //現在のカーソル位置の色をボックスに表示 lcl_BackColor := Brush.Color; Brush.Color := clColorRef; FillRect(Rect(F_rcInfo.Left +2, F_rcInfo.Top +2 +1{ズーム画像との境界のライン分で+1}, F_iFontHeight -2, F_rcInfo.Top + F_iFontHeight -2)); //枠いっぱいではなく2ピクセルづつ狭くする Brush.Color := lcl_BackColor; //枠を描画 // Pen.Color := clBtnShadow; MoveTo(F_rcInfo.Left +1, F_rcInfo.Top +1 +1); LineTo(F_iFontHeight -2, F_rcInfo.Top +1 +1); LineTo(F_iFontHeight -2, F_rcInfo.Top + F_iFontHeight -1 -1); LineTo(F_rcInfo.Left +1, F_rcInfo.Top + F_iFontHeight -1 -1); LineTo(F_rcInfo.Left +1, F_rcInfo.Top +1 +1); //情報表示 F_PutInfo(Sender, li_Height); //縦線 MoveTo(F_iVLine, F_rcInfo.Top + F_iFontHeight +1); LineTo(F_iVLine, ClientHeight); //画像領域と情報領域の間に線を引く Pen.Color := clBtnShadow; MoveTo(0, F_rcInfo.Top); LineTo(ClientWidth, F_rcInfo.Top); end; FormPaint(nil); //拡大画像と各種情報をフォームへ描画 F_iPassTime := li_TickCount; if (Timer_Main.Tag <> FciCapture_RefleshTime) then begin Timer_Main.Tag := FciCapture_RefleshTime; end; end; // if not(actCapture_Pause.Checked) then Timer_Main.Enabled := True; // Timer_Main.Enabled := lb_TimerEnabled; // Application.ProcessMessages; F_bThroughTimer := False; end; procedure TApp_Puffbits.F_PutInfo(Sender: TObject; var iInfoTop: Integer); //FormResizeとコピーとメインタイマーから呼び出されるルーチン procedure lpc_AddList(AList: TStrings; sStr: WideString); //コピーで使われるルーチン begin if (G_bIsNtOs) then begin //NT系OSならUnicodeに対応 AList.Add(gfnsWideToUtf8(sStr)); end else begin AList.Add(sStr); end; end; procedure lpc_DrawInfo(Sender: TObject; sInfo: WideString; var iTop: Integer); //メインタイマーで使われる情報表示ルーチン const //情報表示欄に引くラインのマージン。どれだけ文字から離すか lci_LINEMARGIN = 2; lci_MARGINLEFT = 2; begin if (Sender = Timer_Main) then begin F_bmpZoom.Canvas.MoveTo(0, iTop - lci_LINEMARGIN); F_bmpZoom.Canvas.LineTo(ClientWidth, iTop - lci_LINEMARGIN); if (G_bIsNtOs) then begin //NT系OSならUnicodeに対応 TextOutW(F_bmpZoom.Canvas.Handle, lci_MARGINLEFT, iTop, PWideChar(sInfo), Length(sInfo)); end else begin F_bmpZoom.Canvas.TextOut(lci_MARGINLEFT, iTop, sInfo); end; end; Inc(iTop, F_iFontHeight); end; var lsl_List : TStrings; ls_Text : WideString; ls_File : WideString; li_ErrMode : UINT; li_Width : Integer; li_Height : Integer; // lr_Monitor: TMyMonitorPos; begin Inc(iInfoTop, F_iFontHeight); lsl_List := TStringList.Create; try with F_rDispInfo do begin //カラー値 //RGB if (Sender = actCopy_ColorRGB) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTCOLOR_RGB], [iRed, iGreen, iBlue])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_RGB), [iRed, iGreen, iBlue])); end else if (actColor_RGB.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_RGB), [iRed, iGreen, iBlue]), iInfoTop); end; //HTML if (Sender = actCopy_ColorHtml) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTCOLOR_HTML], [clColor])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_HTML), [LowerCase(IntToHex(clColor, 6))])); end else if (actColor_HTML.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_HTML), [LowerCase(IntToHex(clColor, 6))]), iInfoTop); end; //COLORREF if (Sender = actCopy_ColorCOLORRef) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTCOLOR_COLORREF], [clColorRef])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_COLORREF), [clColorRef, LowerCase(IntToHex(clColorRef, 6))])); end else if (actColor_COLORREF.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTCOLOR_COLORREF), [clColorRef, LowerCase(IntToHex(clColorRef, 6))]), iInfoTop); end; //カーソル位置 //スクリーン座標 if (Sender = actCopy_PosScreen) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTPOS_SCREEN], [ptMousePos.X, ptMousePos.Y])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTPOS_SCREEN), [ptMousePos.X, ptMousePos.Y])); end else if (actPos_Screen.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTPOS_SCREEN), [ptMousePos.X, ptMousePos.Y]), iInfoTop); end; //クライアント座標 if (Sender = actCopy_PosClient) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTPOS_CLIENT], [ptMousePos.X - ptClientPos.X, ptMousePos.Y - ptClientPos.Y])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTPOS_CLIENT), [ptMousePos.X - ptClientPos.X, ptMousePos.Y - ptClientPos.Y, ptClientPos.X, ptClientPos.Y])); end else if (actPos_Client.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTPOS_CLIENT), [ptMousePos.X - ptClientPos.X, ptMousePos.Y - ptClientPos.Y, ptClientPos.X, ptClientPos.Y]), iInfoTop); end; //長さ測定 li_Width := Abs(ptMousePos.X - ptUserPos.X) +1; li_Height := Abs(ptMousePos.Y - ptUserPos.Y) +1; if (Sender = actCopy_PosUser) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTPOS_USER], [li_Width, li_Height, ptUserPos.X, ptUserPos.Y])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTPOS_USER), [li_Width, li_Height, ptUserPos.X, ptUserPos.Y])); end; if (actPos_User.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTPOS_USER), [li_Width, li_Height, ptUserPos.X, ptUserPos.Y]), iInfoTop); end; //ウィンドウ情報 //ウィンドウハンドル if (Sender = actCopy_WinInfoHandle) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_HANDLE], [hWinHandle])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_HANDLE), [LowerCase(IntToHex(hWinHandle, 8)), hWinHandle])); end else if (actWinInfo_Handle.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_HANDLE), [LowerCase(IntToHex(hWinHandle, 8)), hWinHandle]), iInfoTop); end; //クラス名 if (Sender = actCopy_WinInfoClassName) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_CLASSNAME], [sWinClass])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_CLASSNAME), [sWinClass])); end; if (actWinInfo_ClassName.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_CLASSNAME), [sWinClass]), iInfoTop); end; //ウィンドウテキスト if (Sender = actCopy_WinInfoText) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_TEXT], [sWinText])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_TEXT), [sWinText])); end else if (actWinInfo_Text.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_TEXT), [sWinText]), iInfoTop); end; //ウィンドウサイズ 幅、高さ、Left値、Top値 if (Sender = actCopy_WinInfoWindowSize) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_WINDOWSIZE], [szWindowSize.Left, szWindowSize.Top, szWindowSize.Width, szWindowSize.Height, '', ''])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_WINDOWSIZE), [szWindowSize.Width, szWindowSize.Height, szWindowSize.Left, szWindowSize.Top])); end else if (actWinInfo_WindowSize.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_WINDOWSIZE), [szWindowSize.Width, szWindowSize.Height, szWindowSize.Left, szWindowSize.Top]), iInfoTop); end; //クライアントサイズ if (Sender = actCopy_WinInfoClientSize) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_CLIENTSIZE], [szClientSize.Width, szClientSize.Height])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_CLIENTSIZE), [szClientSize.Width, szClientSize.Height])); end else if (actWinInfo_ClientSize.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_CLIENTSIZE), [szClientSize.Width, szClientSize.Height]), iInfoTop); end; //RECT if (Sender = actCopy_WinInfoRect) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_RECT], [rcWinRect.Left, rcWinRect.Top, rcWinRect.Right, rcWinRect.Bottom])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_RECT), [rcWinRect.Left, rcWinRect.Top, rcWinRect.Right, rcWinRect.Bottom])); end else if (actWinInfo_Rect.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_RECT), [rcWinRect.Left, rcWinRect.Top, rcWinRect.Right, rcWinRect.Bottom]), iInfoTop); end; //実行ファイル名 if (Sender = actCopy_WinInfoExeName) then begin lpc_AddList(lsl_List, WideFormat(CopyFmt[G_ciFMTWININFO_EXENAME], [sExeName, gfnsFileNameGet(sExeName)])); end else if (Sender = actCopy_All) then begin lpc_AddList(lsl_List, WideFormat(F_GetDispFmt(G_ciFMTWININFO_EXENAME), [sExeName])); end else if (actWinInfo_ExeName.Checked) then begin lpc_DrawInfo(Sender, WideFormat(F_GetDispFmt(G_ciFMTWININFO_EXENAME), [sExeName]), iInfoTop); end; end; if ((Sender is TAction) and (TAction(Sender).Category = 'コピー')) then begin //ここでクリップボードへコピー if (G_bIsNtOs) then begin ls_Text := gfnsUtf8ToWide(lsl_List.Text); F_PushInfomation(WideFormat(lcsFMT_COPY, [TAction(Sender).Caption, gfnsUtf8ToWide(lsl_List.Text)])); end else begin ls_Text := lsl_List.Text; F_PushInfomation(Format(lcsFMT_COPY, [TAction(Sender).Caption, lsl_List.Text])); end; gpcStrToClipboard(TrimRight(ls_Text)); //Ctrlキーが押されていたらエディターを起動 if (gfnbKeyState(VK_CONTROL)) then begin //ファイルへ保存 ls_File := gfnsWorkFileNameGet('.txt'); //myDebug.gpcDebug(ls_File); li_ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS); try gpcFileWriteText(ls_File, ls_Text); except on EErr: Exception do begin Application.MessageBox(PChar(Format('%s'#13#13'コピー情報を書き込めませんでした', [EErr.Message])), 'エラー'); end; end; SetErrorMode(li_ErrMode); if (gfnbFileExists(ls_File)) then begin if (gfnbIsUnicode(ls_File)) then begin ls_File := gfnsShortFileNameGet(ls_File); end; gpcExecute(ls_File); end; end; end; finally lsl_List.Free; end; end; function TApp_Puffbits.F_GetDrawFont: TFont; begin Result := F_bmpZoom.Canvas.Font; end; //============================================================================== procedure TApp_Puffbits.ApplicationEvents1Activate(Sender: TObject); begin DrawNow; end; procedure TApp_Puffbits.ApplicationEvents1Deactivate(Sender: TObject); begin F_Capture_KeyUp; DrawNow; end; //コピー ----------------------------------------------------------------------- procedure TApp_Puffbits.actCopy_PictureExecute(Sender: TObject); //クリップボードへ画像をコピー var ldc_Desktop: HDC; l_Bitmap: TMyBitmap; ls_File: WideString; ls_Caption: String; lb_Timer: Boolean; li_ErrMode: UINT; li_Rop: DWORD; begin l_Bitmap := TMyBitmap.Create; try l_Bitmap.Width := Self.ClientWidth; l_Bitmap.Height := Self.ClientHeight - ToolBar_Main.Height; //ツールバーは除外 if (F_GetCopyZoomGrid) then begin //グリッドつきでコピー Windows.BitBlt(l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width, l_Bitmap.Height, F_bmpZoom.Canvas.Handle, 0, 0, SRCCOPY); end else begin //グリッドなしでコピー if (actCapture_Pause.Checked) then begin Windows.StretchBlt(l_Bitmap.Canvas.Handle, F_iRulerWidth, F_iRulerWidth, F_szZoom.Width, F_szZoom.Height, F_bmpDesktop.Canvas.Handle, F_rDispInfo.ptMousePos.X - F_szDesktop.Left, F_rDispInfo.ptMousePos.Y - F_szDesktop.Top, F_szDesktop.Width, F_szDesktop.Height, SRCCOPY); end else begin //バッファの画像にはグリッドを引いてあるので新規にキャプチャする //一時停止ではないのでタイマーを止めておく lb_Timer := Timer_Main.Enabled; Timer_Main.Enabled := False; //無駄にはなるがF_bmpDesktopをバッファとして利用 if (actOpt_NoSelfCapture.Checked) then begin li_Rop := SRCCOPY; end else begin li_Rop := SRCCOPY or CAPTUREBLT; end; //マルチモニターも含めたデスクトップ全部のキャプチャ F_bmpDesktop.Width := MyScreenSize.ScreenWidth; F_bmpDesktop.Height := MyScreenSize.ScreenHeight; F_bmpDesktop.Canvas.FillRect(Rect(0, 0, F_bmpDesktop.Width, F_bmpDesktop.Height)); ldc_Desktop := CreateDC('DISPLAY', nil, nil, nil); try Windows.BitBlt(F_bmpDesktop.Canvas.Handle, 0, 0, F_bmpDesktop.Width, F_bmpDesktop.Height, ldc_Desktop, 0, 0, li_Rop); finally DeleteDC(ldc_Desktop); end; Windows.StretchBlt(l_Bitmap.Canvas.Handle, F_iRulerWidth, F_iRulerWidth, F_szZoom.Width, F_szZoom.Height, F_bmpDesktop.Canvas.Handle, F_rDispInfo.ptMousePos.X - F_szDesktop.Left, F_rDispInfo.ptMousePos.Y - F_szDesktop.Top, F_szDesktop.Width, F_szDesktop.Height, SRCCOPY); //情報欄もコピー DrawNow; //情報欄を更新 Windows.BitBlt(l_Bitmap.Canvas.Handle, 0, F_rcInfo.Top, l_Bitmap.Width, l_Bitmap.Height - F_rcInfo.Top, F_bmpZoom.Canvas.Handle, 0, F_rcInfo.Top, SRCCOPY); Timer_Main.Enabled := lb_Timer; end; end; ls_Caption := lcsMARK_PICTURE; Clipboard.Assign(l_Bitmap); if (gfnbKeyState(VK_CONTROL)) then begin //画像をファイルへ保存 ls_File := gfnsWorkFileNameGet('.bmp'); li_ErrMode := SetErrorMode(SEM_FAILCRITICALERRORS); try l_Bitmap.SaveToFile(ls_File); except on EErr: Exception do begin Application.MessageBox(PChar(Format('%s'#13#13'コピー画像を書き込めませんでした', [EErr.Message])), 'エラー'); end; end; SetErrorMode(li_ErrMode); if (gfnbFileExists(ls_File)) then gpcExecute(ls_File); end; finally l_Bitmap.Free; end; F_PushInfomation(Format(lcsFMT_COPY, [ls_Caption, ''])); end; procedure TApp_Puffbits.actCopy_TextExecute(Sender: TObject); var li_Dummy: Integer; begin li_Dummy := 0; F_PutInfo(Sender, li_Dummy); end; //すべてのテキスト情報をクリップボードへコピー procedure TApp_Puffbits.actCopy_AllExecute(Sender: TObject); begin // actCopy_PictureExecute(nil); actCopy_TextExecute(actCopy_All); end; //マウスジェスチャー procedure TApp_Puffbits.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbRight) then begin F_ptGesture := Point(X, Y); end else if (Button = mbLeft) then begin F_ptDragClientPos := gfnptClientMousePosGet(Handle); if (actCapture_Pause.Checked or actCapture_Fixed.Checked) // and (gfnbKeyState(VK_SHIFT)) and not(PtInRect(gfnrcRectShift(F_rcInfo, Point(0, ToolBar_Main.Height)), F_ptDragClientPos)) then begin //ポイント移動開始 SetCaptureControl(Self); F_bDragMove := True; F_ptDragScreenPos := F_rDispInfo.ptMousePos; end else if (gfnbKeyState(VK_CONTROL)) then begin //何もしないがMouseUpメッセージを得るために↓の処理には入らない end else if not(Windows.IsZoomed(Handle)) then begin //つかんで移動 //最大化しても移動できてしまったのでそれへの対処 ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, WPARAM(SC_MOVE or 8), 0); DrawNow; end; end; end; procedure TApp_Puffbits.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var lpt_Pos : TPoint; lr_Monitor : TMyMonitorPos; begin if (F_bDragMove) and (ssLeft in Shift) then begin F_bDragMove := False; //処理しきれないイベントを捨てるためのフラグでもある lpt_Pos := Point( gfniNumLimit(gfniRound((F_ptDragScreenPos.X * F_iZoom + F_ptDragClientPos.X - X) / F_iZoom), MyScreenSize.ScreenLeft, MyScreenSize.DesktopRect.Right -1), gfniNumLimit(gfniRound((F_ptDragScreenPos.Y * F_iZoom + F_ptDragClientPos.Y - Y) / F_iZoom), MyScreenSize.ScreenTop, MyScreenSize.DesktopRect.Bottom -1) ); F_rDispInfo.ptMousePos := lpt_Pos; lr_Monitor := gfnrScreenToMonitor(MyScreenSize, lpt_Pos); if (lr_Monitor.MonitorNum = 0) and (F_iMonitorNum > 0) //AIU then begin F_rDispInfo.ptMousePos.X := gfniNumLimit(F_rDispInfo.ptMousePos.X, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Left, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Right -1); F_rDispInfo.ptMousePos.Y := gfniNumLimit(F_rDispInfo.ptMousePos.Y, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Top, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Bottom -1); end else begin F_iMonitorNum := lr_Monitor.MonitorNum; end; if (actCapture_Fixed.Checked) then begin Timer_InfomationTimer(nil); //定点キャプチャの原点表示を更新 end; DrawNow; Application.ProcessMessages; //余計なキューを捨てる F_bDragMove := True; //元に戻す end; end; //マウスアップ procedure TApp_Puffbits.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var lpt_Pos : TPoint; ls_Compas : WideString; l_Action : TAction; begin if (Button = mbLeft) then begin ReleaseCapture; F_bDragMove := False; if (actCapture_Pause.Checked or actCapture_Fixed.Checked) and (ssCtrl in Shift) and not(ssShift in Shift) then begin //[Ctrl]キーが押されていて[Shift]キーが押されていなければカーソル位置にキャプチャポイントをもっていく FormDblClick(nil); end; end else if (Button = mbRight) and ((F_ptGesture.X > 0) or (F_ptGesture.Y > 0)) then begin //マウスジェスチャー ls_Compas := gfnsCompasGet(F_ptGesture, Point(X, Y)); if (ls_Compas = '') then begin //いわゆる右クリック //ポップアップメニュー lpt_Pos := ClientToScreen(Point(X, Y)); mnuMain.Popup(lpt_Pos.X, lpt_Pos.Y); end else begin if (ls_Compas = '上') then begin l_Action := G_GestureUp; end else if (ls_Compas = '下') then begin l_Action := G_GestureDown; end else if (ls_Compas = '左') then begin l_Action := G_GestureLeft; end else if (ls_Compas = '右') then begin l_Action := G_GestureRight end else begin l_Action := nil; end; if (l_Action <> nil) then begin if (l_Action.AutoCheck) then begin l_Action.Checked := not(l_Action.Checked); end; l_Action.OnExecute(l_Action); end; end; end; end; //------------------------------------------------------------------------------ //カスタマイズ procedure TApp_Puffbits.actCustom_SettingExecute(Sender: TObject); procedure lpc_CreateSettingForm; var i: Integer; begin if (App_PuffbitsSetting = nil) then begin App_PuffbitsSetting := TApp_PuffbitsSetting.Create(G_MainForm); end else begin for i := 0 to Screen.FormCount-1 do begin if (Screen.Forms[i] = App_PuffbitsSetting) then begin Exit; end; end; App_PuffbitsSetting := TApp_PuffbitsSetting.Create(G_MainForm); end; end; begin lpc_CreateSettingForm; with App_PuffbitsSetting do begin if (Sender = actHelp) then begin //ヘルプ PageControl1.ActivePage := tabHelp; end else begin PageControl1.ActivePage := tabSetting; end; Show; end; actOpt_StayOnTopExecute(nil); end; //--- ツールバー --------------------------------------------------------------- //パネルをつかんでフォームを移動 procedure TApp_Puffbits.pnlToolBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin //http://delfusa.main.jp/delfusafloor/archive/VA009712_take/delphi/kabedel.htm if (Button = mbLeft) then begin ReleaseCapture; SendMessage(Handle, WM_SYSCOMMAND, WPARAM(SC_SIZE or 9), 0); end else if (Button = mbRight) then begin F_ptGesture := Point(X, Y); end; end; procedure TApp_Puffbits.actNop(Sender: TObject); begin //ダミー end; //モニター間移動 procedure TApp_Puffbits.actMove_MonitorExecute(Sender: TObject); var lrc_Rect: TRect; begin if (gfnbKeyState(VK_SHIFT)) then begin //プライマリモニターの左上に移動。 SetBounds(0, 0, Width, Height); end else {if (gfnbKeyState(VK_CONTROL)) then} begin //モニター間移動。 lrc_Rect := MyScreenSize.MonitorsRect[gfniNumLoop(MyScreenSize.MonitorNum(Handle) +1, 1, MyScreenSize.MonitorCount) -1]; SetBounds(lrc_Rect.Left, lrc_Rect.Top, Width, Height); end; end; //カーソル移動 procedure TApp_Puffbits.actMove_LeftExecute(Sender: TObject); procedure lpc_CaptureMove(X, Y: Integer); var lr_Monitor : TMyMonitorPos; begin if ((actCapture_Fixed.Checked) or (actCapture_Pause.Checked)) then begin F_rDispInfo.ptMousePos := Point( gfniNumLimit(F_rDispInfo.ptMousePos.X + X, MyScreenSize.ScreenLeft, MyScreenSize.DesktopRect.Right -1), gfniNumLimit(F_rDispInfo.ptMousePos.Y + Y, MyScreenSize.ScreenTop, MyScreenSize.DesktopRect.Bottom -1) ); lr_Monitor := gfnrScreenToMonitor(MyScreenSize, F_rDispInfo.ptMousePos); if (lr_Monitor.MonitorNum = 0) and (F_iMonitorNum > 0) //AIU then begin F_rDispInfo.ptMousePos.X := gfniNumLimit(F_rDispInfo.ptMousePos.X, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Left, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Right -1); F_rDispInfo.ptMousePos.Y := gfniNumLimit(F_rDispInfo.ptMousePos.Y, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Top, MyScreenSize.MonitorsRect[F_iMonitorNum -1].Bottom -1); end else begin F_iMonitorNum := lr_Monitor.MonitorNum; end; Timer_InfomationTimer(nil); DrawNow; end; end; var li_Move: Integer; begin if (gfnbKeyState(VK_SHIFT)) then begin li_Move := 10; end else begin li_Move := 1; end; if (Sender = actMove_Left) then begin if (actCapture_Pause.Checked or actCapture_Fixed.Checked) then begin lpc_CaptureMove(-li_Move, 0); end else begin //カーソル移動← SetCursorPos(F_rDispInfo.ptMousePos.X -li_Move, F_rDispInfo.ptMousePos.Y); end; end else if (Sender = actMove_Right) then begin if (actCapture_Pause.Checked or actCapture_Fixed.Checked) then begin lpc_CaptureMove(li_Move, 0); end else begin //カーソル移動→ SetCursorPos(F_rDispInfo.ptMousePos.X +li_Move, F_rDispInfo.ptMousePos.Y); end; end else if (Sender = actMove_Up) then begin if (actCapture_Pause.Checked or actCapture_Fixed.Checked) then begin lpc_CaptureMove(0, -li_Move); end else begin //カーソル移動↑ SetCursorPos(F_rDispInfo.ptMousePos.X, F_rDispInfo.ptMousePos.Y -li_Move); end; end else if (Sender = actMove_Down) then begin if (actCapture_Pause.Checked or actCapture_Fixed.Checked) then begin lpc_CaptureMove(0, li_Move); end else begin //カーソル移動↓ SetCursorPos(F_rDispInfo.ptMousePos.X, F_rDispInfo.ptMousePos.Y +li_Move); end; end; DrawNow; end; procedure TApp_Puffbits.ApplicationEvents1ShortCut(var Msg: TWMKey; var Handled: Boolean); begin if (Msg.CharCode = VK_MENU) then begin //[Alt]を殺す Handled := True; end; end; procedure TApp_Puffbits.actMenu_MainExecute(Sender: TObject); //メニューのポップアップ var lpt_Pos: TPoint; begin lpt_Pos := ClientToScreen(Point(0, 0)); mnuMain.Popup(lpt_Pos.X, lpt_Pos.Y); end; procedure TApp_Puffbits.actColor_InfoOnOffExecute(Sender: TObject); begin actColor_RGB.Checked := not( (actColor_RGB.Checked) and (actColor_HTML.Checked) and (actColor_COLORREF.Checked) ); actColor_HTML.Checked := actColor_RGB.Checked; actColor_COLORREF.Checked := actColor_RGB.Checked; FormResize(nil) end; procedure TApp_Puffbits.actPos_InfoOnOffExecute(Sender: TObject); begin actPos_Screen.Checked := not( (actPos_Screen.Checked) and (actPos_Client.Checked) and (actPos_User.Checked) ); actPos_Client.Checked := actPos_Screen.Checked; actPos_User.Checked := actPos_Screen.Checked; FormResize(nil) end; procedure TApp_Puffbits.actWinInfo_InfoOnOffExecute(Sender: TObject); begin actWinInfo_Handle.Checked := not( (actWinInfo_Handle.Checked) and (actWinInfo_ClassName.Checked) and (actWinInfo_Text.Checked) and (actWinInfo_WindowSize.Checked) and (actWinInfo_ClientSize.Checked) and (actWinInfo_Rect.Checked) and (actWinInfo_ExeName.Checked) ); actWinInfo_ClassName.Checked := actWinInfo_Handle.Checked; actWinInfo_Text.Checked := actWinInfo_Handle.Checked; actWinInfo_WindowSize.Checked := actWinInfo_Handle.Checked; actWinInfo_ClientSize.Checked := actWinInfo_Handle.Checked; actWinInfo_Rect.Checked := actWinInfo_Handle.Checked; actWinInfo_ExeName.Checked := actWinInfo_Handle.Checked; FormResize(nil); end; //============================================================================== (* const lcsSECT_BOUNDS = 'Bounds'; lcsSECT_ZOOM = 'Zoom'; lcsKEY_ZOOMINDEX = 'ZoomIndex'; lcsSECT_GRID = 'Grid'; lcsKEY_GRIDDISP = 'View'; lcsKEY_GRIDGRIDINDEX = 'GridIndex'; lcsKEY_GRIDSUBGRIDINDEX = 'SubGridIndex'; lcsKEY_GRIDCOLOR = 'Color'; //グリッド色選択で選択した色 lcsKEY_GRIDSUBCOLOR = 'SubColor'; //サブグリッド色選択で選択した色 lcsSECT_POS = 'Position'; lcsKEY_POSSCREEN = 'Screen'; lcsKEY_POSCLIENT = 'Client'; lcsKEY_POSUSER = 'User'; lcsKEY_POSUSERPOS = 'UserPos'; lcsSECT_COLOR = 'ColorInfo'; lcsKEY_COLORRGB = 'RGB'; lcsKEY_COLORHTML = 'HTML'; lcsKEY_COLORCOLORREF = 'COLORREF'; lcsSECT_WININFO = 'WindowInfo'; lcsKEY_WINHANDLE = 'Handle'; lcsKEY_WINCLASSNAME = 'ClassName'; lcsKEY_WINTEXT = 'Text'; lcsKEY_WINWINDOWSIZE = 'WindowSize'; lcsKEY_WINCLIENTSIZE = 'ClientSize'; lcsKEY_WINRECT = 'Rect'; lcsKEY_WINEXENAME = 'ExeName'; lcsSECT_OPT = 'Option'; lcsKEY_OPTSTAYONTOP = 'StayOnTop'; lcsKEY_OPTBIGFONT = 'BigFont'; lcsKEY_OPTNOSELFCAPTURE = 'NoSelfCapture'; lcsKEY_OPTSMOOTHCAPTURE = 'SmoothCapture'; // lcsSECT_MENU = 'Menu'; lcsSECT_SHORTCUT = 'ShortCut'; lcsSECT_COPY = 'Copy'; //設定データの読み込み procedure TApp_Puffbits.F_LoadIni; var l_IniFile: TMyIniFile; li_Index: Integer; begin //Shift+Ctrl起動で設定を読み込まない。 if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then Exit; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try //倍率の設定は最初にやっておく F_iZoomIndex := gfniNumLimit(ReadInteger(lcsSECT_ZOOM, lcsKEY_ZOOMINDEX, mniZoom.Tag), 0, mniZoom.Count -1); actZoomExecute(mniZoom.Items[F_iZoomIndex].Action); //[Grid] //actGrid_DispExecuteを呼ばないのでnotで反転させる必要はない actGrid_Disp.Checked := ReadBool (lcsSECT_GRID, lcsKEY_GRIDDISP, actGrid_Disp.Checked); actGrid_SelColor.Tag := ReadInteger(lcsSECT_GRID, lcsKEY_GRIDCOLOR, actGrid_SelColor.Tag); actGrid_SelSubColor.Tag := ReadInteger(lcsSECT_GRID, lcsKEY_GRIDSUBCOLOR, actGrid_SelSubColor.Tag); //グリッド色 li_Index := gfniNumLimit(ReadInteger(lcsSECT_GRID, lcsKEY_GRIDGRIDINDEX, mniGrid_Gray.MenuIndex), mniGrid_LineGrid.MenuIndex +1, mniGrid_LineSubGrid.MenuIndex -1); if not(mniGrid.Items[li_Index].Visible) then begin li_Index := mniGrid_Gray.MenuIndex; end; TAction(mniGrid.Items[li_Index].Action).Checked := True; actGrid_ColorExecute(mniGrid.Items[li_Index].Action); //サブグリッド色 li_Index := gfniNumLimit(ReadInteger(lcsSECT_GRID, lcsKEY_GRIDSUBGRIDINDEX, mniGrid_SubBlue.MenuIndex), mniGrid_LineSubGrid.MenuIndex +1, mniGrid.Count -1); if not(mniGrid.Items[li_Index].Visible) then begin li_Index := mniGrid_SubBlue.MenuIndex; end; TAction(mniGrid.Items[li_Index].Action).Checked := True; actGrid_SubBlueExecute(mniGrid.Items[li_Index].Action); //[Color] actColor_RGB.Checked := ReadBool(lcsSECT_COLOR, lcsKEY_COLORRGB, actColor_RGB.Checked); actColor_HTML.Checked := ReadBool(lcsSECT_COLOR, lcsKEY_COLORHTML, actColor_HTML.Checked); actColor_COLORREF.Checked := ReadBool(lcsSECT_COLOR, lcsKEY_COLORCOLORREF, actColor_COLORREF.Checked); //[Position] actPos_Screen.Checked := ReadBool (lcsSECT_POS, lcsKEY_POSSCREEN, actPos_Screen.Checked); actPos_Client.Checked := ReadBool (lcsSECT_POS, lcsKEY_POSCLIENT, actPos_Client.Checked); actPos_User.Checked := ReadBool (lcsSECT_POS, lcsKEY_POSUSER, actPos_User.Checked); F_rDispInfo.ptUserPos := ReadPoint(lcsSECT_POS, lcsKEY_POSUSERPOS, Point(0, 0)); F_rDispInfo.ptUserPos.X := gfniNumLimit(F_rDispInfo.ptUserPos.X, 0, MyMonitors.ScreenWidth); F_rDispInfo.ptUserPos.Y := gfniNumLimit(F_rDispInfo.ptUserPos.Y, 0, MyMonitors.ScreenHeight); //[WindowInfo] actWinInfo_Handle.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINHANDLE, actWinInfo_Handle.Checked); actWinInfo_ClassName.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINCLASSNAME, actWinInfo_ClassName.Checked); actWinInfo_Text.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINTEXT, actWinInfo_Text.Checked); actWinInfo_WindowSize.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINWINDOWSIZE, actWinInfo_WindowSize.Checked); actWinInfo_ClientSize.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINCLIENTSIZE, actWinInfo_ClientSize.Checked); actWinInfo_Rect.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINRECT, actWinInfo_Rect.Checked); actWinInfo_ExeName.Checked := ReadBool(lcsSECT_WININFO, lcsKEY_WINEXENAME, actWinInfo_ExeName.Checked); //[Option] actOpt_StayOnTop.Checked := not(ReadBool(lcsSECT_OPT, lcsKEY_OPTSTAYONTOP, actOpt_StayOntop.Checked)); actOpt_StayOnTopExecute(actOpt_StayOnTop); //BigFontはnotで反転させなくてよい actOpt_BigFont.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPTBIGFONT, actOpt_BigFont.Checked); actOpt_BigFontExecute(actOpt_BigFont); actOpt_NoSelfCapture.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPTNOSELFCAPTURE, actOpt_NoSelfCapture.Checked); actOpt_NoSelfCaptureExecute(actOpt_NoSelfCapture); actOpt_SmoothCapture.Checked := ReadBool(lcsSECT_OPT, lcsKEY_OPTSMOOTHCAPTURE, actOpt_SmoothCapture.Checked); actOpt_SmoothCaptureExecute(nil); //------------------------------------------------------------------------------ //準汎用フォーム用 //[ShortCut] gpcReadIniShortCut(l_IniFile, ActionList_Main); //------------------------------------------------------------------------------ //[Bounds] if (gfnbKeyState(VK_SHIFT)) then begin //Shiftキーを押しながら起動で(0,0)に移動 Self.SetBounds(0, 0, Width, Height); Tag := 1; FormResize(nil); end else begin //フォームの大きさ。この処理は最後に持ってこないと拡大倍率セットのとこでエラーになる Self.BoundsRect := ReadBoundsRect(lcsSECT_BOUNDS, Self); Tag := 1; FormResize(nil); if not(gfnbKeyState(VK_CONTROL)) then begin //画面内に収まるように調整 //ただし情報エリアは画面外にはみ出して起動する場合あり。 MyMonitors.SetBounds(Self); end else begin //Ctrlキーを押して起動した場合は調整はせず設定ファイルに従った位置と大きさで起動 //何らかの意図で画面外に起動させたい場合にも対応。 end; end; finally Free; end; end; end; //設定データの保存 procedure TApp_Puffbits.F_SaveIni; var l_IniFile: TMyIniFile; lrc_Rect: TRect; i, li_Index: Integer; begin //Shift+Ctrl終了で設定を書き込まない。 if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then Exit; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try //[Bounds] lrc_Rect := BoundsRect; Dec(lrc_Rect.Bottom, gfniRectHeight(F_rcInfo)); WriteRect(lcsSECT_BOUNDS, Self.Name, lrc_Rect); //[Zoom] WriteInteger(lcsSECT_ZOOM, lcsKEY_ZOOMINDEX, F_iZoomIndex); //[Grid] WriteBool(lcsSECT_GRID, lcsKEY_GRIDDISP, actGrid_Disp.Checked); //選択されているグリッドメニュー li_Index := mniGrid_Gray.MenuIndex; //デフォルトは灰色 for i := mniGrid_LineGrid.MenuIndex +1 to mniGrid_LineSubGrid.MenuIndex -1 do begin if (mniGrid.Items[i].Checked) then begin if (mniGrid.Items[i].Visible) then begin //チェックがついていなければli_Indexはデフォルトのまま li_Index := i; end; Break; end; end; WriteInteger(lcsSECT_GRID, lcsKEY_GRIDGRIDINDEX, li_Index); //選択されているサブグリッドメニュー li_Index := mniGrid_SubBlue.MenuIndex; //デフォルトは青 for i := mniGrid_LineSubGrid.MenuIndex +1 to mniGrid.Count -1 do begin if (mniGrid.Items[i].Checked) then begin if (mniGrid.Items[i].Visible) then begin //チェックがついていなければli_Indexはデフォルトのまま li_Index := i; end; Break; end; end; WriteInteger(lcsSECT_GRID, lcsKEY_GRIDSUBGRIDINDEX, li_Index); //選択色 WriteInteger(lcsSECT_GRID, lcsKEY_GRIDCOLOR, actGrid_SelColor.Tag); WriteInteger(lcsSECT_GRID, lcsKEY_GRIDSUBCOLOR, actGrid_SelSubColor.Tag); //[Color] WriteBool(lcsSECT_COLOR, lcsKEY_COLORRGB, actColor_RGB.Checked); WriteBool(lcsSECT_COLOR, lcsKEY_COLORHTML, actColor_HTML.Checked); WriteBool(lcsSECT_COLOR, lcsKEY_COLORCOLORREF, actColor_COLORREF.Checked); //[Position] WriteBool (lcsSECT_POS, lcsKEY_POSSCREEN, actPos_Screen.Checked); WriteBool (lcsSECT_POS, lcsKEY_POSCLIENT, actPos_Client.Checked); WriteBool (lcsSECT_POS, lcsKEY_POSUSER, actPos_User.Checked); WritePoint(lcsSECT_POS, lcsKEY_POSUSERPOS, F_rDispInfo.ptUserPos); //[WindowsInfo] WriteBool(lcsSECT_WININFO, lcsKEY_WINHANDLE, actWinInfo_Handle.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINCLASSNAME, actWinInfo_ClassName.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINTEXT, actWinInfo_Text.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINWINDOWSIZE, actWinInfo_WindowSize.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINCLIENTSIZE, actWinInfo_ClientSize.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINRECT, actWinInfo_Rect.Checked); WriteBool(lcsSECT_WININFO, lcsKEY_WINEXENAME, actWinInfo_ExeName.Checked); //[Option] WriteBool(lcsSECT_OPT, lcsKEY_OPTSTAYONTOP, actOpt_StayOnTop.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPTBIGFONT, actOpt_BigFont.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPTNOSELFCAPTURE, actOpt_NoSelfCapture.Checked); WriteBool(lcsSECT_OPT, lcsKEY_OPTSMOOTHCAPTURE, actOpt_SmoothCapture.Checked); //------------------------------------------------------------------------------ //準汎用フォーム用 //[ShortCut] gpcWriteIniShortCut(l_IniFile); //------------------------------------------------------------------------------ UpdateFile; finally Free; end; end; end; *) function TApp_Puffbits.Get_CommandToAction(iCmd: Word): TAction; begin case iCmd of G_ciCMDZOOM_1 : Result := actZoom_1; G_ciCMDZOOM_2 : Result := actZoom_2; G_ciCMDZOOM_3 : Result := actZoom_3; G_ciCMDZOOM_4 : Result := actZoom_4; G_ciCMDZOOM_6 : Result := actZoom_6; G_ciCMDZOOM_8 : Result := actZoom_8; G_ciCMDZOOM_10 : Result := actZoom_10; G_ciCMDZOOM_12 : Result := actZoom_12; G_ciCMDZOOM_16 : Result := actZoom_16; G_ciCMDZOOM_20 : Result := actZoom_20; G_ciCMDZOOM_UP : Result := actZoom_Up; G_ciCMDZOOM_DOWN : Result := actZoom_Down; G_ciCMDGRID_DISP : Result := actGrid_Disp; G_ciCMDGRID_GRAY : Result := actGrid_Gray; // G_ciCMDGRID_BLACK : Result := actGrid_Black; // G_ciCMDGRID_WHITE : Result := actGrid_White; G_ciCMDGRID_INVERT : Result := actGrid_Invert; G_ciCMDGRID_TRANSPARENT : Result := actGrid_Transparent; G_ciCMDGRID_SELCOLOR : Result := actGrid_SelColor; G_ciCMDGRID_SUBNONE : Result := actGrid_SubNone; G_ciCMDGRID_SUBBLUE : Result := actGrid_SubBlue; // G_ciCMDGRID_SUBRED : Result := actGrid_SubRed; G_ciCMDGRID_SELSUBCOLOR : Result := actGrid_SelSubColor; // G_ciCMDGRID_USESUBELSECOLOR : Result := actGrid_UseSubElseColor; // G_ciCMDGRID_SELSUBELSECOLOR : Result := actGrid_SelSubElseColor; G_ciCMDCOLOR_RGB : Result := actColor_RGB; G_ciCMDCOLOR_HTML : Result := actColor_HTML; G_ciCMDCOLOR_COLORREF : Result := actColor_COLORREF; // G_ciCMDCOLOR_HSV : Result := actColor_HSV; // G_ciCMDCOLOR_HLS : Result := actColor_HLS; // G_ciCMDCOLOR_HLSWIN : Result := actColor_HLSWin; G_ciCMDCOLOR_INFOONOFF : Result := actColor_InfoOnOff; G_ciCMDPOS_SCREEN : Result := actPos_Screen; // G_ciCMDPOS_MONITOR : Result := actPos_Monitor; G_ciCMDPOS_CLIENT : Result := actPos_Client; G_ciCMDPOS_USER : Result := actPos_User; G_ciCMDPOS_USERPOSSET : Result := actPos_UserPosSet; G_ciCMDPOS_INFOONOFF : Result := actPos_InfoOnOff; G_ciCMDWININFO_HANDLE : Result := actWinInfo_Handle; G_ciCMDWININFO_CLASSNAME : Result := actWinInfo_ClassName; G_ciCMDWININFO_TEXT : Result := actWinInfo_Text; G_ciCMDWININFO_WINDOWSIZE : Result := actWinInfo_WindowSize; G_ciCMDWININFO_CLIENTSIZE : Result := actWinInfo_ClientSize; G_ciCMDWININFO_RECT : Result := actWinInfo_Rect; // G_ciCMDWININFO_CONTROLID : Result := actWinInfo_ControlID; // G_ciCMDWININFO_STYLE : Result := actWinInfo_Style; // G_ciCMDWININFO_PARENTWINDOW : Result := actWinInfo_ParentWindow; // G_ciCMDWININFO_PID : Result := actWinInfo_PID; G_ciCMDWININFO_EXENAME : Result := actWinInfo_ExeName; // G_ciCMDWININFO_FILEVERSION : Result := actWinInfo_FileVersion; // G_ciCMDWININFO_STYLEVERBOSE : Result := actWinInfo_StyleVerbose; // G_ciCMDWININFO_STYLEFOLLOWMAIN : Result := actWinInfo_StyleFollowMain; G_ciCMDWININFO_INFOONOFF : Result := actWinInfo_InfoOnOff; G_ciCMDCOPY_PICTURE : Result := actCopy_Picture; G_ciCMDCOPY_COLORRGB : Result := actCopy_ColorRGB; // G_ciCMDCOPY_COLORRGBRED : Result := actCopy_ColorRGBRed; // G_ciCMDCOPY_COLORRGBGREEN : Result := actCopy_ColorRGBGreen; // G_ciCMDCOPY_COLORRGBBLUE : Result := actCopy_ColorRGBBlue; G_ciCMDCOPY_COLORHTML : Result := actCopy_ColorHTML; G_ciCMDCOPY_COLORCOLORREF : Result := actCopy_ColorCOLORREF; // G_ciCMDCOPY_COLORHSV : Result := actCopy_ColorHSV; // G_ciCMDCOPY_COLORHSVHUE : Result := actCopy_ColorHSVHue; // G_ciCMDCOPY_COLORHSVSATURATION : Result := actCopy_ColorHSVSaturation; // G_ciCMDCOPY_COLORHSVVALUE : Result := actCopy_ColorHSVValue; // G_ciCMDCOPY_COLORHLS : Result := actCopy_ColorHLS; // G_ciCMDCOPY_COLORHLSHUE : Result := actCopy_ColorHLSHue; // G_ciCMDCOPY_COLORHLSSATURATION : Result := actCopy_ColorHLSSaturation; // G_ciCMDCOPY_COLORHLSLIGHTNESS : Result := actCopy_ColorHLSLightness; // G_ciCMDCOPY_COLORHLSWIN : Result := actCopy_ColorHLSWin; // G_ciCMDCOPY_COLORHLSWINHUE : Result := actCopy_ColorHLSWinHue; // G_ciCMDCOPY_COLORHLSWINSATURATION: Result := actCopy_ColorHLSWinSaturation; // G_ciCMDCOPY_COLORHLSWINLIGHTNESS : Result := actCopy_ColorHLSWinLightness; G_ciCMDCOPY_POSSCREEN : Result := actCopy_PosScreen; // G_ciCMDCOPY_POSMONITOR : Result := actCopy_PosMonitor; G_ciCMDCOPY_POSCLIENT : Result := actCopy_PosClient; G_ciCMDCOPY_POSUSER : Result := actCopy_PosUser; G_ciCMDCOPY_WININFOHANDLE : Result := actCopy_WinInfoHandle; G_ciCMDCOPY_WININFOCLASSNAME : Result := actCopy_WinInfoClassName; G_ciCMDCOPY_WININFOTEXT : Result := actCopy_WinInfoText; G_ciCMDCOPY_WININFOWINDOWSIZE : Result := actCopy_WinInfoWindowSize; G_ciCMDCOPY_WININFOCLIENTSIZE : Result := actCopy_WinInfoClientSize; G_ciCMDCOPY_WININFORECT : Result := actCopy_WinInfoRect; // G_ciCMDCOPY_WININFOCONTROLID : Result := actCopy_WinInfoControlID; // G_ciCMDCOPY_WININFOSTYLE : Result := actCopy_WinInfoStyle; // G_ciCMDCOPY_WININFOSTYLEEX : Result := actCopy_WinInfoStyleEx; // G_ciCMDCOPY_WININFOSTYLEVERBOSE : Result := actCopy_WinInfoStyleVerbose; // G_ciCMDCOPY_WININFOPID : Result := actCopy_WinInfoPID; G_ciCMDCOPY_WININFOEXENAME : Result := actCopy_WinInfoExeName; // G_ciCMDCOPY_WININFOFILEVERSION : Result := actCopy_WinInfoFileVersion; G_ciCMDCOPY_ALL : Result := actCopy_All; // G_ciCMDCOPY_OPTUNICODE : Result := actCopy_OptUnicode; G_ciCMDCAPTURE_PAUSE : Result := actCapture_Pause; // G_ciCMDCAPTURE_LUPE : Result := actCapture_Lupe; G_ciCMDCAPTURE_FIXED : Result := actCapture_Fixed; G_ciCMDCAPTURE_UPDATE : Result := actCapture_Update; G_ciCMDCAPTURE_DISP_X1 : Result := actCapture_Disp_x1; // G_ciCMDCAPTURE_MOVECURSORTOPOINT : Result := actCapture_MoveCursorToPoint; // G_ciCMDCAPTURE_POINTFROMCURSOR : Result := actCapture_PointFromCursor; G_ciCMDOPT_STAYONTOP : Result := actOpt_StayOnTop; // G_ciCMDOPT_TOOLBAR : Result := actOpt_ToolBar; G_ciCMDOPT_BIGFONT : Result := actOpt_BigFont; G_ciCMDOPT_NOSELFCAPTURE : Result := actOpt_NoSelfCapture; G_ciCMDOPT_SMOOTHCAPTURE : Result := actOpt_SmoothCapture; G_ciCMDCUSTOM_SETTING : Result := actCustom_Setting; // G_ciCMDCUSTOM_MENU : Result := actCustom_Menu; // G_ciCMDCUSTOM_TOOLBAR : Result := actCustom_ToolBar; G_ciCMDCUSTOM_SHORTCUT : Result := actCustom_ShortCut; // G_ciCMDCUSTOM_COPY : Result := actCustom_Copy; G_ciCMDMENU_MAIN : Result := actMenu_Main; // G_ciCMDMENU_ZOOM : Result := actMenu_Zoom; // G_ciCMDMENU_GRID : Result := actMenu_Grid; // G_ciCMDMENU_COLOR : Result := actMenu_Color; // G_ciCMDMENU_POS : Result := actMenu_Pos; // G_ciCMDMENU_WININFO : Result := actMenu_WinInfo; // G_ciCMDMENU_COPY : Result := actMenu_Copy; // G_ciCMDMENU_SETTING : Result := actMenu_Setting; G_ciCMDMOVE_MONITOR : Result := actMove_Monitor; G_ciCMDMOVE_UP : Result := actMove_Up; G_ciCMDMOVE_DOWN : Result := actMove_Down; G_ciCMDMOVE_LEFT : Result := actMove_Left; G_ciCMDMOVE_RIGHT : Result := actMove_Right; G_ciCMDFILE_MINIMIZE : Result := actFile_Minimize; G_ciCMDFILE_EXIT : Result := actFile_Exit; G_ciCMDHELP : Result := actHelp; else Result := nil; end; end; function TApp_Puffbits.Get_ActionToCommand(AAction: TAction): Word; begin if (AAction = actZoom_1) then begin Result := G_ciCMDZOOM_1; end else if (AAction = actZoom_2) then begin Result := G_ciCMDZOOM_2; end else if (AAction = actZoom_3) then begin Result := G_ciCMDZOOM_3; end else if (AAction = actZoom_4) then begin Result := G_ciCMDZOOM_4; end else if (AAction = actZoom_6) then begin Result := G_ciCMDZOOM_6; end else if (AAction = actZoom_8) then begin Result := G_ciCMDZOOM_8; end else if (AAction = actZoom_10) then begin Result := G_ciCMDZOOM_10; end else if (AAction = actZoom_12) then begin Result := G_ciCMDZOOM_12; end else if (AAction = actZoom_16) then begin Result := G_ciCMDZOOM_16; end else if (AAction = actZoom_20) then begin Result := G_ciCMDZOOM_20; end else if (AAction = actZoom_Up) then begin Result := G_ciCMDZOOM_UP; end else if (AAction = actZoom_Down) then begin Result := G_ciCMDZOOM_DOWN; end else if (AAction = actGrid_Disp) then begin Result := G_ciCMDGRID_DISP; end else if (AAction = actGrid_Gray) then begin Result := G_ciCMDGRID_GRAY; { end else if (AAction = actGrid_Black) then begin Result := G_ciCMDGRID_BLACK; end else if (AAction = actGrid_White) then begin Result := G_ciCMDGRID_WHITE; } end else if (AAction = actGrid_Invert) then begin Result := G_ciCMDGRID_INVERT; end else if (AAction = actGrid_Transparent) then begin Result := G_ciCMDGRID_TRANSPARENT; end else if (AAction = actGrid_SelColor) then begin Result := G_ciCMDGRID_SELCOLOR; end else if (AAction = actGrid_SubNone) then begin Result := G_ciCMDGRID_SUBNONE; end else if (AAction = actGrid_SubBlue) then begin Result := G_ciCMDGRID_SUBBLUE; // end else if (AAction = actGrid_SubRed) then begin // Result := G_ciCMDGRID_SUBRED; end else if (AAction = actGrid_SelSubColor) then begin Result := G_ciCMDGRID_SELSUBCOLOR; { end else if (AAction = actGrid_UseSubElseColor) then begin Result := G_ciCMDGRID_USESUBELSECOLOR; end else if (AAction = actGrid_SelSubElseColor) then begin Result := G_ciCMDGRID_SELSUBELSECOLOR; } end else if (AAction = actColor_RGB) then begin Result := G_ciCMDCOLOR_RGB; end else if (AAction = actColor_HTML) then begin Result := G_ciCMDCOLOR_HTML; end else if (AAction = actColor_COLORREF) then begin Result := G_ciCMDCOLOR_COLORREF; { end else if (AAction = actColor_HSV) then begin Result := G_ciCMDCOLOR_HSV; end else if (AAction = actColor_HLS) then begin Result := G_ciCMDCOLOR_HLS; end else if (AAction = actColor_HLSWin) then begin Result := G_ciCMDCOLOR_HLSWIN; } end else if (AAction = actColor_InfoOnOff) then begin Result := G_ciCMDCOLOR_INFOONOFF; end else if (AAction = actPos_Screen) then begin Result := G_ciCMDPOS_SCREEN; // end else if (AAction = actPos_Monitor) then begin // Result := G_ciCMDPOS_MONITOR; end else if (AAction = actPos_Client) then begin Result := G_ciCMDPOS_CLIENT; end else if (AAction = actPos_User) then begin Result := G_ciCMDPOS_USER; end else if (AAction = actPos_UserPosSet) then begin Result := G_ciCMDPOS_USERPOSSET; end else if (AAction = actPos_InfoOnOff) then begin Result := G_ciCMDPOS_INFOONOFF; end else if (AAction = actWinInfo_Handle) then begin Result := G_ciCMDWININFO_HANDLE; end else if (AAction = actWinInfo_ClassName) then begin Result := G_ciCMDWININFO_CLASSNAME; end else if (AAction = actWinInfo_Text) then begin Result := G_ciCMDWININFO_TEXT; end else if (AAction = actWinInfo_WindowSize) then begin Result := G_ciCMDWININFO_WINDOWSIZE; end else if (AAction = actWinInfo_ClientSize) then begin Result := G_ciCMDWININFO_CLIENTSIZE; end else if (AAction = actWinInfo_Rect) then begin Result := G_ciCMDWININFO_RECT; { end else if (AAction = actWinInfo_ControlID) then begin Result := G_ciCMDWININFO_CONTROLID; end else if (AAction = actWinInfo_Style) then begin Result := G_ciCMDWININFO_STYLE; end else if (AAction = actWinInfo_ParentWindow) then begin Result := G_ciCMDWININFO_PARENTWINDOW; end else if (AAction = actWinInfo_PID) then begin Result := G_ciCMDWININFO_PID; } end else if (AAction = actWinInfo_ExeName) then begin Result := G_ciCMDWININFO_EXENAME; { end else if (AAction = actWinInfo_FileVersion) then begin Result := G_ciCMDWININFO_FILEVERSION; end else if (AAction = actWinInfo_StyleVerbose) then begin Result := G_ciCMDWININFO_STYLEVERBOSE; end else if (AAction = actWinInfo_StyleFollowMain) then begin Result := G_ciCMDWININFO_STYLEFOLLOWMAIN; } end else if (AAction = actWinInfo_InfoOnOff) then begin Result := G_ciCMDWININFO_INFOONOFF; end else if (AAction = actCopy_Picture) then begin Result := G_ciCMDCOPY_PICTURE; end else if (AAction = actCopy_ColorRGB) then begin Result := G_ciCMDCOPY_COLORRGB; { end else if (AAction = actCopy_ColorRGBRed) then begin Result := G_ciCMDCOPY_COLORRGBRED; end else if (AAction = actCopy_ColorRGBGreen) then begin Result := G_ciCMDCOPY_COLORRGBGREEN; end else if (AAction = actCopy_ColorRGBBlue) then begin Result := G_ciCMDCOPY_COLORRGBBLUE; } end else if (AAction = actCopy_ColorHTML) then begin Result := G_ciCMDCOPY_COLORHTML; end else if (AAction = actCopy_ColorCOLORREF) then begin Result := G_ciCMDCOPY_COLORCOLORREF; { end else if (AAction = actCopy_ColorHSV) then begin Result := G_ciCMDCOPY_COLORHSV; end else if (AAction = actCopy_ColorHSVHue) then begin Result := G_ciCMDCOPY_COLORHSVHUE; end else if (AAction = actCopy_ColorHSVSaturation) then begin Result := G_ciCMDCOPY_COLORHSVSATURATION; end else if (AAction = actCopy_ColorHSVValue) then begin Result := G_ciCMDCOPY_COLORHSVVALUE; end else if (AAction = actCopy_ColorHLS) then begin Result := G_ciCMDCOPY_COLORHLS; end else if (AAction = actCopy_ColorHLSHue) then begin Result := G_ciCMDCOPY_COLORHLSHUE; end else if (AAction = actCopy_ColorHLSSaturation) then begin Result := G_ciCMDCOPY_COLORHLSSATURATION; end else if (AAction = actCopy_ColorHLSLightness) then begin Result := G_ciCMDCOPY_COLORHLSLIGHTNESS; end else if (AAction = actCopy_ColorHLSWin) then begin Result := G_ciCMDCOPY_COLORHLSWIN; end else if (AAction = actCopy_ColorHLSWinHue) then begin Result := G_ciCMDCOPY_COLORHLSWINHUE; end else if (AAction = actCopy_ColorHLSWinSaturation) then begin Result := G_ciCMDCOPY_COLORHLSWINSATURATION; end else if (AAction = actCopy_ColorHLSWinLightness) then begin Result := G_ciCMDCOPY_COLORHLSWINLIGHTNESS; } end else if (AAction = actCopy_PosScreen) then begin Result := G_ciCMDCOPY_POSSCREEN; { end else if (AAction = actCopy_PosMonitor) then begin Result := G_ciCMDCOPY_POSMONITOR; } end else if (AAction = actCopy_PosClient) then begin Result := G_ciCMDCOPY_POSCLIENT; end else if (AAction = actCopy_PosUser) then begin Result := G_ciCMDCOPY_POSUSER; end else if (AAction = actCopy_WinInfoHandle) then begin Result := G_ciCMDCOPY_WININFOHANDLE; end else if (AAction = actCopy_WinInfoClassName) then begin Result := G_ciCMDCOPY_WININFOCLASSNAME; end else if (AAction = actCopy_WinInfoText) then begin Result := G_ciCMDCOPY_WININFOTEXT; end else if (AAction = actCopy_WinInfoWindowSize) then begin Result := G_ciCMDCOPY_WININFOWINDOWSIZE; end else if (AAction = actCopy_WinInfoClientSize) then begin Result := G_ciCMDCOPY_WININFOCLIENTSIZE; end else if (AAction = actCopy_WinInfoRect) then begin Result := G_ciCMDCOPY_WININFORECT; { end else if (AAction = actCopy_WinInfoControlID) then begin Result := G_ciCMDCOPY_WININFOCONTROLID; end else if (AAction = actCopy_WinInfoStyle) then begin Result := G_ciCMDCOPY_WININFOSTYLE; end else if (AAction = actCopy_WinInfoStyleEx) then begin Result := G_ciCMDCOPY_WININFOSTYLEEX; end else if (AAction = actCopy_WinInfoStyleVerbose) then begin Result := G_ciCMDCOPY_WININFOSTYLEVERBOSE; end else if (AAction = actCopy_WinInfoPID) then begin Result := G_ciCMDCOPY_WININFOPID; } end else if (AAction = actCopy_WinInfoExeName) then begin Result := G_ciCMDCOPY_WININFOEXENAME; { end else if (AAction = actCopy_WinInfoFileVersion) then begin Result := G_ciCMDCOPY_WININFOFILEVERSION; } end else if (AAction = actCopy_All) then begin Result := G_ciCMDCOPY_ALL; // end else if (AAction = actCopy_OptUnicode) then begin // Result := G_ciCMDCOPY_OPTUNICODE; end else if (AAction = actCapture_Pause) then begin Result := G_ciCMDCAPTURE_PAUSE; // end else if (AAction = actCapture_Lupe) then begin // Result := G_ciCMDCAPTURE_LUPE; end else if (AAction = actCapture_Fixed) then begin Result := G_ciCMDCAPTURE_FIXED; end else if (AAction = actCapture_Update) then begin Result := G_ciCMDCAPTURE_UPDATE; end else if (AAction = actCapture_Disp_x1) then begin Result := G_ciCMDCAPTURE_DISP_X1; { end else if (AAction = actCapture_MoveCursorToPoint) then begin Result := G_ciCMDCAPTURE_MOVECURSORTOPOINT; end else if (AAction = actCapture_PointFromCursor) then begin Result := G_ciCMDCAPTURE_POINTFROMCURSOR; } end else if (AAction = actOpt_StayOnTop) then begin Result := G_ciCMDOPT_STAYONTOP; // end else if (AAction = actOpt_ToolBar) then begin // Result := G_ciCMDOPT_TOOLBAR; end else if (AAction = actOpt_BigFont) then begin Result := G_ciCMDOPT_BIGFONT; end else if (AAction = actOpt_NoSelfCapture) then begin Result := G_ciCMDOPT_NOSELFCAPTURE; end else if (AAction = actOpt_SmoothCapture) then begin Result := G_ciCMDOPT_SMOOTHCAPTURE; end else if (AAction = actCustom_Setting) then begin Result := G_ciCMDCUSTOM_SETTING; { end else if (AAction = actCustom_Menu) then begin Result := G_ciCMDCUSTOM_MENU; end else if (AAction = actCustom_ToolBar) then begin Result := G_ciCMDCUSTOM_TOOLBAR; } end else if (AAction = actCustom_ShortCut) then begin Result := G_ciCMDCUSTOM_SHORTCUT; // end else if (AAction = actCustom_Copy) then begin // Result := G_ciCMDCUSTOM_COPY; end else if (AAction = actMenu_Main) then begin Result := G_ciCMDMENU_MAIN; { end else if (AAction = actMenu_Zoom) then begin Result := G_ciCMDMENU_ZOOM; end else if (AAction = actMenu_Grid) then begin Result := G_ciCMDMENU_GRID; end else if (AAction = actMenu_Color) then begin Result := G_ciCMDMENU_COLOR; end else if (AAction = actMenu_Pos) then begin Result := G_ciCMDMENU_POS; end else if (AAction = actMenu_WinInfo) then begin Result := G_ciCMDMENU_WININFO; end else if (AAction = actMenu_Copy) then begin Result := G_ciCMDMENU_COPY; end else if (AAction = actMenu_Setting) then begin Result := G_ciCMDMENU_SETTING; } //[Move] end else if (AAction = actMove_Monitor) then begin Result := G_ciCMDMOVE_MONITOR; end else if (AAction = actMove_Up) then begin Result := G_ciCMDMOVE_UP; end else if (AAction = actMove_Down) then begin Result := G_ciCMDMOVE_DOWN; end else if (AAction = actMove_Left) then begin Result := G_ciCMDMOVE_LEFT; end else if (AAction = actMove_Right) then begin Result := G_ciCMDMOVE_RIGHT; //[File] end else if (AAction = actFile_Minimize) then begin Result := G_ciCMDFILE_MINIMIZE; end else if (AAction = actFile_Exit) then begin Result := G_ciCMDFILE_EXIT; //[Help] end else if (AAction = actHelp) then begin Result := G_ciCMDHELP; end else begin Result := 0; end; end; //カスタマイズ------------------------------------------------------------------ procedure TApp_Puffbits.actCustom_ShortCutExecute(Sender: TObject); begin gpcCreateShortCutForm; App_CustomShortCut.Show; actOpt_StayOnTopExecute(nil); end; procedure TApp_Puffbits.btnCapture_MoveLeftMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var li_Delay: DWORD; begin if not(Sender is TSpeedButton) then begin Exit; end; F_MoveButton := TSpeedButton(Sender); Timer_CaptureMoveTimer(nil); //http://mrxray.on.coocan.jp/Delphi/plSamples/S04_SystemParametersInfo_Interface.htm#03 if not(SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @li_Delay, 0))then begin li_Delay := 250; end; Timer_CaptureMove.Interval := (li_Delay +1) * 250; Timer_CaptureMove.Enabled := True; end; procedure TApp_Puffbits.btnCapture_MoveLeftMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Timer_CaptureMove.Enabled := False; end; procedure TApp_Puffbits.Timer_CaptureMoveTimer(Sender: TObject); var li_KeySpeed : DWORD; begin if (F_MoveButton = btnCapture_MoveLeft) then begin actMove_Left.OnExecute(actMove_Left); end else if (F_MoveButton = btnCapture_MoveRight) then begin actMove_Right.OnExecute(actMove_Right); end else if (F_MoveButton = btnCapture_MoveUp) then begin actMove_Up.OnExecute(actMove_Up); end else if (F_MoveButton = btnCapture_MoveDown) then begin actMove_Down.OnExecute(actMove_Down); end; DrawNow; //http://mrxray.on.coocan.jp/Delphi/plSamples/S04_SystemParametersInfo_Interface.htm#03 if not(SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @li_KeySpeed, 0))then begin li_KeySpeed := 100; end; Timer_CaptureMove.Interval := 400 - (li_KeySpeed * 12); if not(gfnbKeyState(VK_LBUTTON)) then Timer_CaptureMove.Enabled := False; end; function TApp_Puffbits.F_LoadBin: Boolean; var // lr_SettingInfo: T_SettingInfo; // lr_ShortCutKeys: array[0..G_ciKEYCOUNT-1] of T_ShortCutKey; // lr_MouseGesture: T_MouseGesture; k, li_Left, li_Top, li_Width, li_Height: Integer; begin Result := G_fnbSettingRead; //(lr_SettingInfo, lr_ShortCutKeys, lr_MouseGesture); if not(Result) then begin Exit; end; with G_rSettingInfo do begin //[Zoom] //倍率の設定は最初にやっておく F_iZoomIndex := gfniNumLimit(iZoomIndex, 0, mniZoom.Count -1); actZoomExecute(mniZoom.Items[F_iZoomIndex].Action); //[Grid] //actGrid_DispExecuteを呼ばないのでnotで反転させる必要はない actGrid_Disp.Checked := (iGridFlag and G_ciFLGGRID_DISP) = G_ciFLGGRID_DISP; actGrid_SelColor.Tag := clGridColor; actGrid_SelSubColor.Tag := clSubGridColor; //グリッド色 TAction(mniGrid.Items[iGridIndex].Action).Checked := True; actGrid_ColorExecute(mniGrid.Items[iGridIndex].Action); //サブグリッド色 //サブメニュー iSubGridIndex := iSubGridIndex + (mniGrid_LineSubGrid.MenuIndex +1); TAction(mniGrid.Items[iSubGridIndex].Action).Checked := True; actGrid_SubBlueExecute(mniGrid.Items[iSubGridIndex].Action); //[Color] actColor_RGB.Checked := (iColorFlag and G_ciFLGCOLOR_RGB) = G_ciFLGCOLOR_RGB; actColor_HTML.Checked := (iColorFlag and G_ciFLGCOLOR_HTML) = G_ciFLGCOLOR_HTML; actColor_COLORREF.Checked := (iColorFlag and G_ciFLGCOLOR_REF) = G_ciFLGCOLOR_REF; //[Position] actPos_Screen.Checked := (iPosFlag and G_ciFLGPOS_SCREEN) = G_ciFLGPOS_SCREEN; actPos_Client.Checked := (iPosFlag and G_ciFLGPOS_CLIENT) = G_ciFLGPOS_CLIENT; actPos_User.Checked := (iPosFlag and G_ciFLGPOS_USER) = G_ciFLGPOS_USER; F_rDispInfo.ptUserPos.X := gfniNumLimit(ptUserPos.X, 0, MyScreenSize.ScreenWidth); F_rDispInfo.ptUserPos.Y := gfniNumLimit(ptUserPos.Y, 0, MyScreenSize.ScreenHeight); //[WindowInfo] actWinInfo_Handle.Checked := (iWInfoFlag and G_ciFLGWINFO_HANDLE) = G_ciFLGWINFO_HANDLE; actWinInfo_ClassName.Checked := (iWInfoFlag and G_ciFLGWINFO_CNAME) = G_ciFLGWINFO_CNAME; actWinInfo_Text.Checked := (iWInfoFlag and G_ciFLGWINFO_TEXT) = G_ciFLGWINFO_TEXT; actWinInfo_WindowSize.Checked := (iWInfoFlag and G_ciFLGWINFO_WSIZE) = G_ciFLGWINFO_WSIZE; actWinInfo_ClientSize.Checked := (iWInfoFlag and G_ciFLGWINFO_CSIZE) = G_ciFLGWINFO_CSIZE; actWinInfo_Rect.Checked := (iWInfoFlag and G_ciFLGWINFO_RECT) = G_ciFLGWINFO_RECT; actWinInfo_ExeName.Checked := (iWInfoFlag and G_ciFLGWINFO_EXENAME) = G_ciFLGWINFO_EXENAME; //[Option] actOpt_StayOnTop.Checked := not((iOptFlag and G_ciFLGOPT_STAYONTOP) = G_ciFLGOPT_STAYONTOP); actOpt_BigFont.Checked := (iOptFlag and G_ciFLGOPT_BIGFONT) = G_ciFLGOPT_BIGFONT; actOpt_NoSelfCapture.Checked := (iOptFlag and G_ciFLGOPT_NOSELF) = G_ciFLGOPT_NOSELF; actOpt_SmoothCapture.Checked := (iOptFlag and G_ciFLGOPT_SMOOTH) = G_ciFLGOPT_SMOOTH; actOpt_StayOnTopExecute (actOpt_StayOnTop); actOpt_BigFontExecute (actOpt_BigFont); actOpt_NoSelfCaptureExecute(actOpt_NoSelfCapture); actOpt_SmoothCaptureExecute(actOpt_SmoothCapture); //[Capture] actCapture_Fixed.Checked := (iCaptureFlag and G_ciFLGCAPTURE_FIXED) = G_ciFLGCAPTURE_FIXED; if (actCapture_Fixed.Checked) then begin // actCapture_FixedExecute(actCapture_Fixed); F_rDispInfo.ptMousePos := ptCaptruePos; end; //[ShortCutKey] gpcClearShortCut; for k := 0 to High(G_rShortCutKeys) do begin if (G_rShortCutKeys[k].iCommand <> 0) then begin G_ShortCutList.Add(T_ShortCutAction.Create(G_rShortCutKeys[k].iKey, Get_CommandToAction(G_rShortCutKeys[k].iCommand))); end; end; //[MouseGesture] G_GestureUp := Get_CommandToAction(G_rMouseGesture.iCommand_Up); G_GestureDown := Get_CommandToAction(G_rMouseGesture.iCommand_Down); G_GestureLeft := Get_CommandToAction(G_rMouseGesture.iCommand_Left); G_GestureRight := Get_CommandToAction(G_rMouseGesture.iCommand_Right); //[Bounds] if (gfniRectWidth (rcRect) <= FciMINSIZE) or (gfniRectHeight(rcRect) <= FciMINSIZE) then begin li_Width := Width; li_Height := Height; end else begin //[Bounds] li_Width := gfniRectWidth(rcRect); li_Height := gfniRectHeight(rcRect); end; if (gfnbKeyState(VK_SHIFT)) then begin //Shiftキーを押しながら起動で(0,0)に移動 li_Left := 0; li_Top := 0; end else begin li_Left := rcRect.Left; li_Top := rcRect.Top; end; SetBounds(li_Left, li_Top, li_Width, li_Height); if not(gfnbKeyState(VK_CONTROL)) then begin //画面内に収まるように調整 //ただし情報エリアは画面外にはみ出して起動する場合あり。 MyScreenSize.SetBounds(Self); end else begin //Ctrlキーを押して起動した場合は調整はせず設定ファイルに従った位置と大きさで起動 //何らかの意図で画面外に起動させたい場合にも対応。 end; end; end; procedure TApp_Puffbits.F_SaveBin; var // lr_SettingInfo: T_SettingInfo; // lr_ShortCutKeys: array[0..G_ciKEYCOUNT-1] of T_ShortCutKey; // lr_MouseGesture: T_MouseGesture; i, k: Integer; li_Key: Word; begin with G_rSettingInfo do begin rcRect := Self.BoundsRect; Dec(rcRect.Bottom, gfniRectHeight(F_rcInfo)); //[Zoom] iZoomIndex := F_iZoomIndex; //[Grid] iGridFlag := 0; if (actGrid_Disp.Checked) then begin iGridFlag := iGridFlag or G_ciFLGGRID_DISP; end; iGridIndex := mniGrid_Gray.MenuIndex; for i := mniGrid_LineGrid.MenuIndex +1 to mniGrid_LineSubGrid.MenuIndex -1 do begin if (mniGrid.Items[i].Checked) then begin iGridIndex := i; Break; end; end; //選択されているサブグリッドメニュー iSubGridIndex := mniGrid_SubBlue.MenuIndex; for i := mniGrid_LineSubGrid.MenuIndex +1 to mniGrid.Count -1 do begin if (mniGrid.Items[i].Checked) then begin iSubGridIndex := i; Break; end; end; iSubGridIndex := iSubGridIndex - (mniGrid_LineSubGrid.MenuIndex +1); //選択色 clGridColor := actGrid_SelColor.Tag; clSubGridColor := actGrid_SelSubColor.Tag; //[Color] iColorFlag := 0; if (actColor_RGB.Checked) then begin iColorFlag := iColorFlag or G_ciFLGCOLOR_RGB; end; if (actColor_HTML.Checked) then begin iColorFlag := iColorFlag or G_ciFLGCOLOR_HTML; end; if (actColor_COLORREF.Checked) then begin iColorFlag := iColorFlag or G_ciFLGCOLOR_REF; end; //[Position] iPosFlag := 0; if (actPos_Screen.Checked) then begin iPosFlag := iPosFlag or G_ciFLGPOS_SCREEN; end; if (actPos_Client.Checked) then begin iPosFlag := iPosFlag or G_ciFLGPOS_CLIENT; end; if (actPos_User.Checked) then begin iPosFlag := iPosFlag or G_ciFLGPOS_USER; end; ptUserPos := F_rDispInfo.ptUserPos; //[WindowsInfo] iWInfoFlag := 0; if (actWinInfo_Handle.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_HANDLE; end; if (actWinInfo_ClassName.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_CNAME; end; if (actWinInfo_Text.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_TEXT; end; if (actWinInfo_WindowSize.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_WSIZE; end; if (actWinInfo_ClientSize.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_CSIZE; end; if (actWinInfo_Rect.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_RECT; end; if (actWinInfo_ExeName.Checked) then begin iWInfoFlag := iWInfoFlag or G_ciFLGWINFO_EXENAME; end; //[Option] iOptFlag := 0; if (actOpt_StayOnTop.Checked) then begin iOptFlag := iOptFlag or G_ciFLGOPT_STAYONTOP; end; if (actOpt_BigFont.Checked) then begin iOptFlag := iOptFlag or G_ciFLGOPT_BIGFONT; end; if (actOpt_NoSelfCapture.Checked) then begin iOptFlag := iOptFlag or G_ciFLGOPT_NOSELF; end; if (actOpt_SmoothCapture.Checked) then begin iOptFlag := iOptFlag or G_ciFLGOPT_SMOOTH; end; //[Capture] iCaptureFlag := 0; if (actCapture_Fixed.Checked) then begin iCaptureFlag := G_ciFLGCAPTURE_FIXED; end; ptCaptruePos := F_rDispInfo.ptMousePos; end; FillChar(G_rShortCutKeys, SizeOf(G_rShortCutKeys), 0); for i := 0 to G_ShortCutList.Count-1 do begin li_Key := T_ShortCutAction(G_ShortCutList.Items[i]).Key; for k := 0 to High(G_rShortCutKeys) do begin G_rShortCutKeys[k].iKey := G_rINIT_SHORTCUTKEYS[k].iKey; if (G_rShortCutKeys[k].iKey = li_Key) then begin G_rShortCutKeys[k].iCommand := Get_ActionToCommand(T_ShortCutAction(G_ShortCutList.Items[i]).Action); Break; end; end; end; FillChar(G_rMouseGesture, SizeOf(G_rMouseGesture), 0); with G_rMouseGesture do begin iCommand_Up := Get_ActionToCommand(G_GestureUp); iCommand_Down := Get_ActionToCommand(G_GestureDown); iCommand_Left := Get_ActionToCommand(G_GestureLeft); iCommand_Right := Get_ActionToCommand(G_GestureRight); end; G_pcSettingWrite; //(lr_SettingInfo, lr_ShortCutKeys, lr_MouseGesture); end; end.