unit main; //{$DEFINE _DEBUG} interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus, ActnList, AppEvnts, ComCtrls, ImgList, jpeg, ToolWin, myFileDialog, myMessagePanel, myWStrings, childwin, System.ImageList, System.Actions; {$R CustomFileDialog.RES} //brcc32 CustomFileDialog.RC type TColorBox = class(TCustomColorBox) public function PickCustomColor: Boolean; override; published property AutoComplete; property AutoDropDown; property DefaultColorColor; property NoneColorColor; property Selected; property Style; property Anchors; property BevelEdges; property BevelInner; property BevelKind; property BevelOuter; property BiDiMode; property Color; property Constraints; property Ctl3D; property DropDownCount; property Enabled; property Font; property ItemHeight; property ParentBiDiMode; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property TabOrder; property TabStop; property Visible; property OnChange; property OnCloseUp; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnDropDown; property OnEndDock; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnSelect; property OnStartDock; property OnStartDrag; end; type TApp_TOOLDskCapt = class(TForm) ActionList1: TActionList; Action_File_SaveAs: TAction; Action_File_SaveAsFormat: TAction; Action_File_SaveBmp: TAction; Action_File_SaveGif: TAction; Action_File_SaveJpeg: TAction; Action_File_SaveGifAnime: TAction; Action_File_SaveAvi: TAction; Action_File_GifTransparent: TAction; Action_File_SaveSerialNum: TAction; Action_File_Exit: TAction; actEdit_Undo: TAction; actEdit_Redo: TAction; actEdit_Cut: TAction; actEdit_Copy: TAction; actEdit_Paste: TAction; actEdit_Replace: TAction; actEdit_Del: TAction; actCapture_StartStop: TAction; actCapture_Object: TAction; actCapture_HotKey: TAction; actCapture_BGColor: TAction; actCapture_Area: TAction; actCapture_Multi: TAction; actCapture_Sequence: TAction; actCapture_Interval: TAction; actCapture_MouseCursor: TAction; actCapture_PrintWindow: TAction; actCapture_ActiveWindow: TAction; actProgram: TAction; actProgram_Add: TAction; actProgram_Del: TAction; actProgram_Run: TAction; actProgram_Foreground: TAction; actProgram_ListDel: TAction; actFrame_Back: TAction; actFrame_Next: TAction; actFrame_Head: TAction; actFrame_End: TAction; Action_ZoomAlwaysFit: TAction; actZoom_Fit: TAction; actZoom_100: TAction; actZoom_Up: TAction; actZoom_Down: TAction; actDisp_ToolBar: TAction; actDisp_CtrlPanel: TAction; actCustom_ToolBar: TAction; actWindow_Cascade: TAction; actWindow_TileTopBottom: TAction; actWindow_TileLeftRight: TAction; actWindow_CloseAll: TAction; actWindow_ConfirmSave: TAction; actHelp_VersionInfo: TAction; Menu_Main: TMainMenu; mniFile: TMenuItem; mniFile_Save: TMenuItem; MenuItem_SaveAsFormat: TMenuItem; mniFile_SaveBMP: TMenuItem; mniFile_SaveJPEG: TMenuItem; mniFile_SaveGIF: TMenuItem; mniFile_Save_Line1: TMenuItem; mniFile_SaveGIFAnime: TMenuItem; mniFile_SaveAVI: TMenuItem; mniFile_Save_Line2: TMenuItem; mniFile_GIFTransparent: TMenuItem; mniFile_SaveSerialNum: TMenuItem; mniFile_Line1: TMenuItem; mniProgram: TMenuItem; mniProgram_Add: TMenuItem; mniProgram_Del: TMenuItem; mniProgram_Line1: TMenuItem; mniProgram_Line2: TMenuItem; mniProgram_Foreground: TMenuItem; mniFile_Line2: TMenuItem; mniFile_Exit: TMenuItem; mniEdit: TMenuItem; mniEdit_Cut: TMenuItem; mniEdit_Copy: TMenuItem; mniEdit_Replace: TMenuItem; mniEdit_Paste: TMenuItem; mniEdit_Del: TMenuItem; mniCapture: TMenuItem; mniCapture_Start: TMenuItem; mniCapture_Line1: TMenuItem; mniCapture_Object: TMenuItem; mniCapture_HotKey: TMenuItem; mniCapture_BGColor: TMenuItem; mniCapture_Line2: TMenuItem; mniCapture_Multi: TMenuItem; mniCapture_Sequence: TMenuItem; mniCapture_Line3: TMenuItem; mniCapture_ActiveWindow: TMenuItem; mniCapture_PrintWindow: TMenuItem; mniCapture_Cursor: TMenuItem; mniZoom: TMenuItem; mniZoom_AlwaysFit: TMenuItem; mniZoom_100: TMenuItem; mniZoom_Line1: TMenuItem; mniZoom_Up: TMenuItem; mniZoom_Down: TMenuItem; mniZoom_Fit: TMenuItem; mniOpt: TMenuItem; mniDisp_ToolBar: TMenuItem; mniDisp_CtrlPanel: TMenuItem; MenuItem_Opt_Line1: TMenuItem; mniCustom_ToolBar: TMenuItem; mniWindow: TMenuItem; mniWindow_Cascade: TMenuItem; mniWindow_TileTopBottom: TMenuItem; mniWindow_TileLeftRight: TMenuItem; mniWindow_CloseAll: TMenuItem; mniWindow_Line1: TMenuItem; mniWindow_ConfirmSave: TMenuItem; mniWindow_Line2: TMenuItem; mniHelp: TMenuItem; mniHelp_VersionInfo: TMenuItem; Menu_Program: TPopupMenu; MenuItemProgram_Add: TMenuItem; MenuItemProgram_Del: TMenuItem; MenuItemProgram_Line1: TMenuItem; MenuItemProgram_Run: TMenuItem; MenuItemProgram_Line2: TMenuItem; MenuItemProgram_Foreground: TMenuItem; mnuToolObject: TPopupMenu; mnuToolHotKey: TPopupMenu; mnuToolBGColor: TPopupMenu; __Menu_Child: TPopupMenu; MenuItemChild_Edit_Cut: TMenuItem; MenuItemChild_Edit_Copy: TMenuItem; MenuItemChild__Line1: TMenuItem; MenuItemChild_Zoom_Fit: TMenuItem; MenuItemChild_Zoom_100: TMenuItem; MenuItemChild__Line2: TMenuItem; MenuItemChild_Zoom_Up: TMenuItem; MenuItemChild_Zoom_Down: TMenuItem; MenuItemChild_Line3: TMenuItem; MenuItemChild_Edit_Paste: TMenuItem; MenuItemChild_Edit_Del: TMenuItem; MenuItemChild_File_SaveAs: TMenuItem; mnuToolBar: TPopupMenu; mniPCustom_ToolBar: TMenuItem; mnuToolProgram: TPopupMenu; Menu_Program_Del: TPopupMenu; Menu_Save: TPopupMenu; MenuItemToolSave_File_SaveGifAnime: TMenuItem; MenuItemToolSave_File_SaveAvi: TMenuItem; MenuItem_ToolSave_File_Line2: TMenuItem; MenuItemToolSave_File_GifTransparent: TMenuItem; MenuItemToolSave_File_SaveSerialNum: TMenuItem; MenuItem_ToolSave_File_Line1: TMenuItem; MenuItemToolSave_File_SaveBmp: TMenuItem; MenuItemToolSave_File_SaveJpeg: TMenuItem; MenuItemToolSave_File_SaveGif: TMenuItem; Panel_Cmd: TPanel; shpLine: TShape; grpObject: TRadioGroup; grpHotKey: TGroupBox; lstHotKey: TComboBox; grpBGColor: TGroupBox; lstBGColor: TColorBox; grpProgram: TGroupBox; lstProgram: TListBox; chkProgram_Foreground: TCheckBox; btnStart: TButton; btnCopy: TButton; btnSave: TButton; pnlFileDialog_CustomBase: TPanel; chkFile_SendToShortFileName: TCheckBox; Dialog_File_SaveAs: TMySaveFileDialog; Dialog_Program: TMyOpenFileDialog; Timer1: TTimer; MessagePanel: TMyMessagePanel; ImageList_Program: TImageList; ImageList_Icon: TImageList; ToolBar_Main: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton4: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton9: TToolButton; ToolButton10: TToolButton; ToolButton11: TToolButton; ToolButton12: TToolButton; ToolButton13: TToolButton; ToolButton14: TToolButton; ToolButton15: TToolButton; ToolButton16: TToolButton; ToolButton17: TToolButton; ToolButton18: TToolButton; ToolButton19: TToolButton; ToolButton20: TToolButton; ToolButton21: TToolButton; ToolButton22: TToolButton; ToolButton23: TToolButton; ToolButton25: TToolButton; ToolButton24: TToolButton; ToolButton26: TToolButton; ToolButton27: TToolButton; ToolButton28: TToolButton; ToolButton29: TToolButton; ToolButton30: TToolButton; ToolButton31: TToolButton; ToolButton32: TToolButton; ToolButton33: TToolButton; ToolButton34: TToolButton; ToolButton35: TToolButton; ToolButton36: TToolButton; ToolButton37: TToolButton; ToolButton38: TToolButton; ToolButton39: TToolButton; ToolButton40: TToolButton; ToolButton41: TToolButton; ToolButton42: TToolButton; ToolButton43: TToolButton; Action_ZoomSmooth: TAction; ToolButton44: TToolButton; MenuItem_ZoomSmooth: TMenuItem; Action_File_AviRGB24: TAction; Action_File_AviRGB32: TAction; MenuItem_File_SaveAsFormat_Line3: TMenuItem; MenuItem_File_AviRGB24: TMenuItem; MenuItem_File_AviRGB32: TMenuItem; MenuItem_ToolSave_File_Line3: TMenuItem; MenuItem_PFile_AviRGB24: TMenuItem; MenuItem_PFile_AviRGB32: TMenuItem; Action_Opt_LargeIcon: TAction; MenuItem_Opt_Line2: TMenuItem; MenuItem_Opt_LargeIcon: TMenuItem; Action_Opt_AeroThemeOnOff: TAction; MenuItem_Opt_AeroThemeOnOff: TMenuItem; procedure actNop(Sender: TObject); procedure Action_File_SaveAsExecute (Sender: TObject); procedure Action_File_SaveBmpExecute (Sender: TObject); procedure Action_File_ExitExecute (Sender: TObject); procedure actProgram_AddExecute (Sender: TObject); procedure actProgram_DelExecute (Sender: TObject); procedure actProgram_RunExecute (Sender: TObject); procedure actEdit_UndoExecute (Sender: TObject); procedure actEdit_RedoExecute (Sender: TObject); procedure actEdit_CutExecute (Sender: TObject); procedure actEdit_CopyExecute (Sender: TObject); procedure actEdit_PasteExecute (Sender: TObject); procedure actEdit_ReplaceExecute (Sender: TObject); procedure actEdit_DelExecute (Sender: TObject); procedure actCapture_StartStopExecute (Sender: TObject); procedure actCapture_AreaExecute (Sender: TObject); procedure actCapture_SequenceExecute (Sender: TObject); procedure actCapture_MultiExecute (Sender: TObject); procedure actFrame_BackExecute (Sender: TObject); procedure actFrame_NextExecute (Sender: TObject); procedure actFrame_HeadExecute (Sender: TObject); procedure actFrame_EndExecute (Sender: TObject); procedure Action_ZoomAlwaysFitExecute (Sender: TObject); procedure actZoom_FitExecute (Sender: TObject); procedure actZoom_100Execute (Sender: TObject); procedure actZoom_UpExecute (Sender: TObject); procedure actZoom_DownExecute (Sender: TObject); procedure actDisp_ToolBarExecute (Sender: TObject); procedure actDisp_CtrlPanelExecute (Sender: TObject); procedure actCustom_ToolBarExecute (Sender: TObject); procedure actWindow_CascadeExecute (Sender: TObject); procedure actWindow_TileLeftRightExecute(Sender: TObject); procedure actWindow_TileTopBottomExecute(Sender: TObject); procedure actWindow_CloseAllExecute (Sender: TObject); procedure actHelp_VersionInfoExecute (Sender: TObject); procedure FormCreate (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy(Sender: TObject); procedure FormShow (Sender: TObject); procedure Menu_ProgramPopup (Sender: TObject); procedure __Menu_ChildPopup (Sender: TObject); procedure mniFileAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure mniProgram_RunDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); procedure mniWindowClick (Sender: TObject); procedure grpObjectClick (Sender: TObject); procedure lstHotKeySelect (Sender: TObject); procedure lstBGColorSelect (Sender: TObject); procedure lstProgramDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lstProgramClick (Sender: TObject); procedure Timer1Timer (Sender: TObject); procedure MessagePanelTextChange (Sender: TObject; Text: String); procedure Dialog_File_SaveAsTypeChange(Sender: TObject); procedure Action_Opt_LargeIconExecute(Sender: TObject); procedure Action_Opt_AeroThemeOnOffExecute(Sender: TObject); private { Private 宣言 } FiVKeyCode : Word; FclBGColor : TColor; FbExit : Boolean; FiStartIndex : Integer; FiObjectIndex : Integer; FiFileIndex : Integer; FbKeyPress : Boolean; FCaptWindow : TApp_TOOLDskCaptWindow; FrcArea : TRect; //ラージアイコン FBitmap_ImageList : TBitmap; // FhAreaWindow : HWND; FhAreaMessage : HWND; FIntervalCapt : TApp_TOOLDskCaptWindow; FhClipbrdWnd : HWND; //クリップボード監視 function FGetAreaMessageWindow: HWND; function FIsExistAreaWindow: Boolean; procedure FCreateAreaWindow; function FGetWorkareaWidth: Integer; function FGetWorkareaHeight: Integer; procedure FShowAreaWindow; procedure FHideAreaWindow; procedure FCloseAreaWindow; function FGetCaptWindow: TApp_TOOLDskCaptWindow; procedure FSetCaptWindow(ACaptWindow: TApp_TOOLDskCaptWindow); procedure FCreateProgramMenu; function FGetToplevelWindow(ptPos: TPoint): HWND; procedure FDoCapture; procedure FOnSelectObject (Sender: TObject); procedure FOnSelectHotKey (Sender: TObject); procedure FOnSelectBGColor(Sender: TObject); procedure FSetObject (sObject: WideString); procedure FSetHotKey (sKey : WideString); procedure FSetBGColor (sColor : WideString); function FLoadIni : Boolean; procedure FSaveIni; //ディスプレイ設定の変更 procedure WMDisplayChange(var Msg: TMessage); message WM_DISPLAYCHANGE; //クリップボード監視 procedure FEntryClipboardViewer; procedure FRemoveClipboardViewer; procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD; procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN; //システム終了 procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QUERYENDSESSION; protected procedure WndProc(var Msg: TMessage); override; public { Public 宣言 } function GetWindowMenuItem(hHandle: HWND): TMenuItem; property CaptWindow : TApp_TOOLDskCaptWindow read FCaptWindow write FSetCaptWindow; property BgColor : TColor read FclBGColor; property WorkareaWidth : Integer read FGetWorkareaWidth; property WorkareaHeight : Integer read FGetWorkareaHeight; end; var App_TOOLDskCapt : TApp_TOOLDskCapt; G_MainForm : TApp_TOOLDskCapt; const G_ciOBJECT_SCREEN = 0; G_ciOBJECT_MONITOR = 1; G_ciOBJECT_WINDOW = 2; G_ciOBJECT_CLIENT = 3; G_ciOBJECT_CONTROL = 4; G_ciOBJECT_AREA = 5; G_ciFILESAVE_BMP = 1; G_ciFILESAVE_JPEG = 2; G_ciFILESAVE_GIF = 3; G_ciFILESAVE_GIFANIME = 4; G_ciFILESAVE_AVI = 5; G_ciFILESAVE_PNG = 6; G_ciFILESAVE_TIFF = 6; implementation uses {$IFDEF _DEBUG} myDebug, {$ENDIF} ActiveX, Clipbrd, ComObj, DWMApi, ShellAPI, ShlObj, myControl, myFile, myGraphic, myHelpVersionInfo, myIniFile, myMenu, myMessageDlg, myMonitor, myNum, myParam, myShortCut, mySize, myString, myWindow, myZoomBox, area, area_ctrl, custom_toolbar; {$R *.dfm} function TColorBox.PickCustomColor: Boolean; begin Result := inherited PickCustomColor; end; //============================================================================== function TApp_TOOLDskCapt.GetWindowMenuItem(hHandle : HWND) : TMenuItem; var i, k : Integer; l_MenuItem : TMenuItem; l_Child : TApp_TOOLDskCaptWindow; begin Result := nil; for i := 0 to G_MainForm.MDIChildCount-1 do begin l_Child := TApp_TOOLDskCaptWindow(G_MainForm.MDIChildren[i]); if (l_Child.Handle = hHandle) then begin for k := mniWindow_Line1.MenuIndex to mniWindow.Count-1 do begin l_MenuItem := mniWindow.Items[k]; if (HWND(l_MenuItem.Tag) = hHandle) then begin //目的のメニューアイテム Result := l_MenuItem; Exit; end; end; end; end; end; function TApp_TOOLDskCapt.FGetCaptWindow: TApp_TOOLDskCaptWindow; var i : Integer; begin Result := nil; for i := 0 to Screen.CustomFormCount-1 do begin if (Screen.CustomForms[i] = FCaptWindow) then begin Result := TApp_TOOLDskCaptWindow(Screen.CustomForms[i]); Break; //Exitではいけない end; end; FCaptWindow := Result; end; procedure TApp_TOOLDskCapt.FSetCaptWindow(ACaptWindow: TApp_TOOLDskCaptWindow); var i : Integer; begin if (ACaptWindow = nil) then begin FIntervalCapt := nil; end; //メニューセット FCaptWindow := nil; for i := 0 to Self.MDIChildCount-1 do begin if (ACaptWindow = nil) then begin if not(csDestroying in Self.MDIChildren[i].ComponentState) then begin FCaptWindow := TApp_TOOLDskCaptWindow(Self.MDIChildren[i]); Break; end; end else if (Self.MDIChildren[i] = ACaptWindow) then begin FCaptWindow := ACaptWindow; __Menu_ChildPopup(nil); Break; end; end; __Menu_ChildPopup(nil); end; procedure TApp_TOOLDskCapt.__Menu_ChildPopup(Sender: TObject); //メニューポップアップ var l_MenuItem : TMenuItem; begin if (FCaptWindow <> nil) then begin Action_File_SaveAs.Enabled := (FCaptWindow.BitmapWidth > 0) and (FCaptWindow.BitmapHeight > 0); Action_File_SaveBmp.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveJpeg.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveGif.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveGifAnime.Enabled := Action_File_SaveAs.Enabled and (FCaptWindow.FrameCount > 0); Action_File_SaveAvi.Enabled := Action_File_SaveGifAnime.Enabled; l_MenuItem := GetWindowMenuItem(FCaptWindow.Handle); if (l_MenuItem <> nil) then begin l_MenuItem.Checked := True; end; end else begin Action_File_SaveAs.Enabled := False; Action_File_SaveBmp.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveJpeg.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveGif.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveGifAnime.Enabled := Action_File_SaveAs.Enabled; Action_File_SaveAvi.Enabled := Action_File_SaveGifAnime.Enabled; end; actEdit_Copy.Enabled := Action_File_SaveAs.Enabled; actZoom_Fit. Enabled := Action_File_SaveAs.Enabled; actZoom_100. Enabled := Action_File_SaveAs.Enabled; actZoom_Up. Enabled := Action_File_SaveAs.Enabled; actZoom_Down.Enabled := Action_File_SaveAs.Enabled; actEdit_Cut.Enabled := (FCaptWindow <> nil) and (FCaptWindow.FrameCount > 1); actEdit_Del.Enabled := actEdit_Cut.Enabled; actEdit_Paste.Enabled := (FCaptWindow <> nil) and Clipboard.HasFormat(CF_BITMAP); actEdit_Replace.Enabled := actEdit_Paste.Enabled; actFrame_Back.Enabled := actEdit_Cut.Enabled and (FCaptWindow.Frame > 0); actFrame_Next.Enabled := actEdit_Cut.Enabled and (FCaptWindow.Frame < FCaptWindow.FrameCount -1); actFrame_Head.Enabled := actFrame_Back.Enabled; actFrame_End.Enabled := actFrame_Next.Enabled; end; //クリップボード監視ルーチン --------------------------------------------------- procedure TApp_TOOLDskCapt.FEntryClipboardViewer; begin FhClipbrdWnd := SetClipboardViewer(Handle); if ((FhClipbrdWnd = 0) and (GetLastError <> 0)) then begin {エラーだったら} //クリップボードの更新チェックの登録処理に失敗した場合の処理 //ShowMessage('クリップボードの更新チェックの登録処理に失敗しました'); end; end; procedure TApp_TOOLDskCapt.FRemoveClipboardViewer; begin //クリップボード監視処理の破棄 ChangeClipboardChain(Handle, FhClipbrdWnd); end; procedure TApp_TOOLDskCapt.WMDrawClipboard(var Msg: TWMDrawClipboard); //クリップボード更新フック //更新された後に流れてくる。 //アプリが立ち上がった瞬間も流れる begin inherited; if (FhClipbrdWnd <> 0) then begin //次の監視ウィンドウへメッセージ送信 SendMessage(FhClipbrdWnd, WM_DRAWCLIPBOARD, 0, 0); end; __Menu_ChildPopup(nil); end; procedure TApp_TOOLDskCapt.WMChangeCBChain(var Msg: TWMChangeCBChain); begin if (Msg.Remove = FhClipbrdWnd) then begin //クリップボードをフックしている次のウィンドウがフックを解除した FhClipbrdWnd := Msg.Next; end; if (FhClipbrdWnd <> 0) then begin //次のビューアへメッセージ送信 SendMessage(FhClipbrdWnd, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next); end; end; //------------------------------------------------------------------------------ procedure TApp_TOOLDskCapt.actCapture_StartStopExecute(Sender: TObject); //開始 begin if (actCapture_StartStop.Tag = 0) then begin //開始を押した FIntervalCapt := nil; if (grpObject.ItemIndex = G_ciOBJECT_AREA) then begin FCreateAreaWindow; end; actCapture_StartStop.Tag := 1; actCapture_StartStop.Caption := '停止(&S)'; actCapture_StartStop.Hint := '停止'; actCapture_StartStop.ImageIndex := FiStartIndex +1; FIntervalCapt := nil; //インターバルモードで取得したイメージを送るフォーム FbKeyPress := False; Timer1.Enabled := True; Application.Title := Format('%s '#13'対象：%s '#13'ホットキー：%s', [Self.Caption, grpObject.Items[grpObject.ItemIndex], lstHotKey.Items[lstHotKey.ItemIndex]]); Application.Minimize; end else begin //停止を押した FbKeyPress := True; Timer1.Enabled := False; actCapture_StartStop.Caption := '開始(&S)'; actCapture_StartStop.Hint := '開始'; actCapture_StartStop.Tag := 0; actCapture_StartStop.ImageIndex := FiStartIndex; Application.Title := Self.Caption; end; end; procedure TApp_TOOLDskCapt.Timer1Timer(Sender: TObject); var li_Key : SHORT; lb_KeyState : Boolean; begin Timer1.Enabled := False; if (Application.Terminated) then begin Exit; end; li_Key := GetAsyncKeyState(FiVKeyCode); { if (actCapture_Multi.Checked) and (li_Key <> VK_RBUTTON) and (li_Key <> VK_MBUTTON) then begin lb_KeyState := BOOL(Hi(li_Key)) and BOOL(Lo(li_Key)); end else begin lb_KeyState := BOOL(Hi(li_Key)); end; } lb_KeyState := BOOL(Hi(li_Key)) and BOOL(Lo(li_Key)); if (lb_KeyState) then begin if not(FbKeyPress) then begin FDoCapture; if (actCapture_Multi.Checked) or (actCapture_Sequence.Checked) then begin //複数＆連続キャプチャの場合は元のサイズに戻さない end else begin //↓で終了処理を行っている actCapture_StartStopExecute(nil); //複数キャプチャではない if (FbExit) then begin FbExit := False; //プログラム終了 Action_File_ExitExecute(nil); end else begin if (IsIconic(Application.Handle)) then begin Application.Restore; end; end; end; end; end; if not(FbKeyPress) then begin Timer1.Enabled := True; end; end; function TApp_TOOLDskCapt.FGetToplevelWindow(ptPos: TPoint): HWND; begin Result := GetAncestor(WindowFromPoint(ptPos), GA_ROOT); end; procedure TApp_TOOLDskCapt.FDoCapture; var l_ScreenBitmap : TScreenBitmap; begin Beep; l_ScreenBitmap := TScreenBitmap.Create; try l_ScreenBitmap.BGColor := FclBGColor; l_ScreenBitmap.IsMouseCursor := actCapture_MouseCursor.Checked; l_ScreenBitmap.IsPrintWindow := actCapture_PrintWindow.Checked; case grpObject.ItemIndex of G_ciOBJECT_SCREEN :begin //全画面 (デスクトップ全体) l_ScreenBitmap.CaptureDesktop; end; G_ciOBJECT_MONITOR :begin //モニター if (actCapture_ActiveWindow.Checked) then begin //アクティブウィンドウのあるモニター l_ScreenBitmap.CaptureMonitor; end else begin l_ScreenBitmap.CaptureMonitor(gfnptMousePosGet); end; end; G_ciOBJECT_WINDOW :begin //ウィンドウ (トップレベルウィンドウ) if (actCapture_ActiveWindow.Checked) then begin //アクティブなトップレベルウィンドウ l_ScreenBitmap.CaptureToplevelWindow; end else begin l_ScreenBitmap.CaptureToplevelWindow(FGetToplevelWindow(gfnptMousePosGet)); end; end; G_ciOBJECT_CLIENT :begin //クライアント領域 (トップレベルウィンドウのクライアント領域) if (actCapture_ActiveWindow.Checked) then begin //アクティブなトップレベルウィンドウのクライアント領域 l_ScreenBitmap.CaptureClientWindow; end else begin l_ScreenBitmap.CaptureClientWindow(FGetToplevelWindow(gfnptMousePosGet)); end; end; G_ciOBJECT_CONTROL :begin //コントロール (ウィンドウ) if (actCapture_ActiveWindow.Checked) then begin l_ScreenBitmap.CaptureControl; end else begin l_ScreenBitmap.CaptureControl(gfnptMousePosGet); end; end; G_ciOBJECT_AREA :begin //範囲選択 myMessagePanel.gpcMessagePanelUnicast('/DOCAPTURE', FhAreaMessage); l_ScreenBitmap.CaptureArea(FrcArea); myMessagePanel.gpcMessagePanelUnicast('/CAPTURE_DONE', FhAreaMessage); end; else begin Exit; end; end; if (actCapture_Sequence.Checked) and (FIntervalCapt <> nil) then begin //連続キャプチャ //一つのウィンドウに追加していく FGetCaptWindow.AddFrame(l_ScreenBitmap); end else begin Inc(FiFileIndex); FIntervalCapt := gfnCreateCaptWindow(l_ScreenBitmap, grpObject.ItemIndex, FiFileIndex); end; finally l_ScreenBitmap.Free; end; actEdit_CopyExecute(nil); end; procedure TApp_TOOLDskCapt.FormCreate(Sender: TObject); procedure _SubRadioMenuCreate(AMenuItem: TMenuItem; AList: TStrings; AOnClick: TNotifyEvent; iCheckIndex: Integer); var i : Integer; ls_Name : String; l_MenuItem : TMenuItem; begin for i := 0 to AList.Count-1 do begin //頭に'__'をつけることでメニューカスタマイズから除外する ls_Name := gfnsAvailableName(Format('__%s', [AMenuItem.Name])); l_MenuItem := NewItem( AList[i], //Caption 0, //ShortCut False, //Checked True, //Enabled AOnClick, //OnClickイベント 0, //HelpContext ls_Name //Name ); // l_MenuItem.AutoCheck := True; NG! l_MenuItem.RadioItem := True; l_menuItem.Checked := (i = iCheckIndex); l_MenuItem.OnAdvancedDrawItem := mniFileAdvancedDrawItem; AMenuItem.Add(l_MenuItem); end; end; var l_Monitor : TMonitor; begin {$IFDEF _DEBUG} // myDebug.gpcMessageModeSet(True); {$ENDIF} G_MainForm := Self; Application.Title := Self.Caption; Self.Constraints.MinWidth := Width; Self.Constraints.MinHeight := Panel_Cmd.Height + 100; l_Monitor := gfnMonitorGet(gfnptMousePosGet); //デフォルト640*360 SetBounds(l_Monitor.WorkareaRect.Left + 75, l_Monitor.WorkareaRect.Top + 75, Self.Width, Self.Height); Dialog_File_SaveAs.InitialDir := gfnsMyPicturePathGet; Dialog_Program.InitialDir := gfnsProgramFilesPathGet; FiStartIndex := actCapture_StartStop.ImageIndex; FiObjectIndex := actCapture_Object. ImageIndex; _SubRadioMenuCreate(mniCapture_Object, grpObject.Items, FOnSelectObject, grpObject.ItemIndex); _SubRadioMenuCreate(mnuToolObject.Items, grpObject.Items, FOnSelectObject, grpObject.ItemIndex); _SubRadioMenuCreate(mniCapture_HotKey, lstHotKey.Items, FOnSelectHotKey, lstHotKey.ItemIndex); _SubRadioMenuCreate(mnuToolHotKey.Items, lstHotKey.Items, FOnSelectHotKey, lstHotKey.ItemIndex); _SubRadioMenuCreate(mniCapture_BGColor, lstBGColor.Items, FOnSelectBGColor, lstBGColor.ItemIndex); _SubRadioMenuCreate(mnuToolBGColor.Items, lstBGColor.Items, FOnSelectBGColor, lstBGColor.ItemIndex); FBitmap_ImageList := nil; //ツールバー gpcCreateToolBarForm(Self); App_CustomToolBar.AddToolBar('ツールバー', ToolBar_Main); //クリップボード監視 FEntryClipboardViewer; if not(FLoadIni) then begin lstBGColor.ItemIndex := 1; end; MessagePanelTextChange(nil, ParamW.ShiftParams.Text); Tag := 1; grpObjectClick (nil); lstHotKeySelect (nil); lstBGColorSelect(nil); Menu_ProgramPopup(nil); if (FbExit) then begin actCapture_StartStopExecute(nil); end; end; procedure TApp_TOOLDskCapt.FormClose(Sender: TObject; var Action: TCloseAction); var i : Integer; l_NowCapt, l_CaptWindow : TApp_TOOLDskCaptWindow; begin Action := caFree; if (App_TOOLDskCapt.actWindow_ConfirmSave.Checked) then begin l_NowCapt := FGetCaptWindow; for i := Self.MDIChildCount-1 downto 0 do begin l_CaptWindow := TApp_TOOLDskCaptWindow(Self.MDIChildren[i]); if not(l_CaptWindow.Saved) then begin FSetCaptWindow(l_CaptWindow); //SaveAs; l_CaptWindow.Close; if (l_CaptWindow.CloseAction = ID_CANCEL) then begin FSetCaptWindow(l_NowCapt); Action := caNone; end; end; end; end; end; procedure TApp_TOOLDskCapt.FormDestroy(Sender: TObject); begin //クリップボード監視を解除 FRemoveClipboardViewer; FSaveIni; FreeAndNil(FBitmap_ImageList); if (FIsExistAreaWindow) then begin FCloseAreaWindow; end; end; function TApp_TOOLDskCapt.FIsExistAreaWindow: Boolean; begin if (IsWindow(FhAreaMessage)) then begin Result := True; Exit; end else begin FhAreaMessage := FGetAreaMessageWindow; end; Result := IsWindow(FhAreaMessage); end; var lhAreaWindow: HWND; function TApp_TOOLDskCapt.FGetAreaMessageWindow: HWND; function _EnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall; begin Result := True; if (gfnsClassNameGet(hHandle) = 'TApp_TOOLDskCaptArea') then begin if (FindWindowEx(hHandle, 0, 'TGrabHandle', nil) = 0) then begin //TGrabHandleとうぃうウィンドウはなかったので設計中のフォームではない //つまりこのhHndleが目的のプログラムのウィンドウハンドル //必要な処理を終えたので以降の処理(トップレベルウィンドウの列挙)を続行しない lhAreaWindow := hHandle; Result := False; end; end; end; begin Result := 0; lhAreaWindow := 0; EnumWindows(@_EnumWindowProc, 0); if (IsWindow(lhAreaWindow)) then begin Result := FindWindowEx(lhAreaWindow, 0, 'TMyMessagePanel', nil); end; end; procedure TApp_TOOLDskCapt.FShowAreaWindow; begin if (FIsExistAreaWindow) then begin myMessagePanel.gpcMessagePanelUnicast('/SHOW', FhAreaMessage); end; end; procedure TApp_TOOLDskCapt.FHideAreaWindow; begin if (FIsExistAreaWindow) then begin myMessagePanel.gpcMessagePanelUnicast('/HIDE', FhAreaMessage); end; end; procedure TApp_TOOLDskCapt.FCloseAreaWindow; begin if (FIsExistAreaWindow) then begin myMessagePanel.gpcMessagePanelUnicast('/CLOSE', FhAreaMessage); end; end; procedure TApp_TOOLDskCapt.WMQueryEndSession(var Msg: TWMQueryEndSession); begin //http://www.wwlnk.com/boheme/delphi/tips/tec0690.htm FormDestroy(Self); Msg.Result := 1; end; procedure TApp_TOOLDskCapt.WMDisplayChange(var Msg: TMessage); //TScreenのMonitorsプロパティがディスプレイの変更に追随しない不具合の回避のためだけ。 begin Self.Monitor; end; procedure TApp_TOOLDskCapt.FormShow(Sender: TObject); begin //最小化から復帰したらキャプチャ後終了をキャンセル。 FbExit := False; end; procedure TApp_TOOLDskCapt.MessagePanelTextChange(Sender: TObject; Text: String); function _GetInt(var sVal : WideString): Integer; var li_Index : Integer; ls_Value : WideString; begin ls_Value := sVal; if (sVal = '') then begin Result := 0; end else begin gpcVal(sVal, Result, li_Index); if (li_Index > 0) then begin sVal := Copy(sVal, li_Index +1, MAXINT); end else begin sVal := ''; end; end; end; procedure _GetAreaRect(sValue : WideString; var ARect : TRect); begin //Left,Top,Right,Bottom ARect.Left := _GetInt(sValue); ARect.Top := _GetInt(sValue); ARect.Right := _GetInt(sValue); ARect.Bottom := _GetInt(sValue); end; var i : Integer; l_Message : TMyParam; l_OptionParam : TMyParamOption; ls_Opt : WideString; ls_Value : WideString; begin if (Application.Terminated) then begin Exit; end; l_Message := TMyParam.Create(Text); try for i := 0 to l_Message.Count-1 do begin l_OptionParam := l_Message.OptionParam[i]; if (l_OptionParam.IsOption) then begin ls_Opt := Trim(l_OptionParam.OptionText); ls_Value := Trim(l_OptionParam.ValueText); if (ls_Opt = 'AREA_WINDOW') then begin //範囲選択の範囲を受信。 _GetAreaRect(ls_Value, FrcArea); end else if (ls_Opt = 'AREA_WINDOW_CANCEL') then begin //範囲選択のキャンセルを受信。 if (actCapture_StartStop.Tag <> 0) then begin //キャプチャを停止する。 actCapture_StartStopExecute(nil); if (IsIconic(Application.Handle)) then begin Application.Restore; end; end; end else if (ls_Opt = 'AREA_WINDOW_CAPTUREEXECUTE') then begin //キャプチャ実行の指示。 FDoCapture; end else (* /O:{S|M|W|C|T} /K:{RB|MB|SHIFT|SPC|ESC|F1|F2|F3|F4|F5|F6|F7|F8|F9|F10|F11|F12} /B:#xxxxxx /S[:ファイル] /W[:{ON|OFF}] /N[:{ON|OFF}] /X[:{ON|OFF}] *) if (ls_Opt = 'O') or (ls_Opt = 'OBJ') or (ls_Opt = 'OBJECT') then begin //Object 対象。 FSetObject(ls_Value); end else if (ls_Opt = 'K') or (ls_Opt = 'KEY') or (ls_Opt = 'HOTKEY') then begin //HotKey ホットキー。 FSetHotKey(ls_Value); end else if (ls_Opt = 'B') or (ls_Opt = 'BG') or (ls_Opt = 'BGCOLOR') or (ls_Opt = 'BACGROUNDCOLOR') then begin //BGColor 背景色 FSetBGColor(ls_Value); end else if (ls_Opt = 'X') or (ls_Opt = 'EXIT') then begin //eXit 処理終了後プログラム終了 FbExit := (ls_Value = 'ON'); end; end; end; finally l_Message.Free; end; end; //--- キャプチャ対象 ----------------------------------------------------------- procedure TApp_TOOLDskCapt.FSetObject(sObject: WideString); //Object 対象 var lb_Area : Boolean; li_Tag : Integer; begin sObject := gfnsStrToHalf(WideUpperCase(sObject)); //範囲選択以外なら選択ウィンドウを閉じる lb_Area := False; //2回呼ばれるのを回避するため li_Tag := Self.Tag; Self.Tag := 0; try if (sObject = 'M') or (sObject = 'MON') or (sObject = 'MONITOR') or (sObject = 'ﾓﾆﾀ') or (sObject = 'ﾓﾆﾀｰ') or (sObject = grpObject.Items[G_ciOBJECT_MONITOR]) then begin //Monitor モニター grpObject.ItemIndex := G_ciOBJECT_MONITOR; end else if (sObject = 'W') or (sObject = 'WIN') or (sObject = 'WINDOW') or (sObject = 'ｳｨﾝﾄﾞｳ') or (sObject = grpObject.Items[G_ciOBJECT_WINDOW]) then begin //Window トップレベルウィンドウ grpObject.ItemIndex := G_ciOBJECT_WINDOW; end else if (sObject = 'C') or (sObject = 'CLIENT') or (sObject = 'CLIENTAREA') or (sObject = 'ｸﾗｲｱﾝﾄ') or (sObject = 'ｸﾗｲｱﾝﾄｴﾘｱ') or (sObject = 'ｸﾗｲｱﾝﾄ領域') or (sObject = grpObject.Items[G_ciOBJECT_CLIENT]) then begin //Client トップレベルウィンドウのクライアントエリア grpObject.ItemIndex := G_ciOBJECT_CLIENT; end else if (sObject = 'O') or (sObject = 'OBJ') or (sObject = 'OBJECT') or (sObject = 'T') or (sObject = 'CTL') or (sObject = 'CTRL') or (sObject = 'CONTROL') or (sObject = 'ｺﾝﾄﾛｰﾙ') or (sObject = grpObject.Items[G_ciOBJECT_CONTROL]) then begin //conTrol コントロール(ウィンドウ) grpObject.ItemIndex := G_ciOBJECT_CONTROL; end else if (sObject = 'A') or (sObject = 'AREA') or (sObject = '範囲') or (sObject = '範囲選択') or (sObject = '選択範囲') or (sObject = grpObject.Items[G_ciOBJECT_AREA]) then begin //Area 範囲選択 grpObject.ItemIndex := G_ciOBJECT_AREA; lb_Area := True; end else { if (sObject = 'S') or (sObject = 'SCRN') or (sObject = 'SCREEN') or (sObject = 'DESKTOP') or (sObject = 'ｽｸﾘｰﾝ') or (sObject = grpObject.Items[G_ciROW_SCREEN]) then begin } begin //Screen 全画面 //デフォルト grpObject.ItemIndex := G_ciOBJECT_SCREEN; end; finally Self.Tag := li_Tag; end; mniCapture_Object.Items[grpObject.ItemIndex].Checked := True; mnuToolObject. Items[grpObject.ItemIndex].Checked := True; actCapture_Object.ImageIndex := FiObjectIndex + grpObject.ItemIndex; if (lb_Area) then begin FCreateAreaWindow; end else begin FHideAreaWindow; end; end; procedure TApp_TOOLDskCapt.grpObjectClick(Sender: TObject); begin if (Tag = 0) // or (grpObject.Tag = 0) then begin Exit; end; FSetObject(grpObject.Items[grpObject.ItemIndex]); end; procedure TApp_TOOLDskCapt.FOnSelectObject(Sender: TObject); var l_MenuItem : TMenuItem; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); l_MenuItem.Checked := True; FSetObject(grpObject.Items[l_MenuItem.MenuIndex]); end; //--- ホットキー --------------------------------------------------------------- procedure TApp_TOOLDskCapt.FSetHotKey(sKey: WideString); var ls_Item : String; li_Index : Integer; begin sKey := gfnsStrToHalf(WideUpperCase(sKey)); sKey := gfnsStrReplace(sKey, 'ｷｰ', ''); ls_Item := sKey; //コンボボックスとメニューの選択アイテムとの整合性を取るため。 if (sKey = '右ｸﾘｯｸ') or (sKey = 'RB') or (sKey = 'RBUTTON') then begin FiVKeyCode := VK_RBUTTON; ls_Item := '右クリック'; end else if (sKey = '中ｸﾘｯｸ') or (sKey = 'MB') or (sKey = 'MBUTTON') then begin FiVKeyCode := VK_MBUTTON; ls_Item := '中クリック'; end else if (sKey = 'ｼﾌﾄ') or (sKey = 'SHIFT') then begin FiVKeyCode := VK_SHIFT; ls_Item := 'シフトキー'; end else if (sKey = 'ｽﾍﾟｰｽ') or (sKey = 'SP') or (sKey = 'SPC') or (sKey = 'SPACE') then begin FiVKeyCode := VK_SPACE; ls_Item := 'スペースキー'; end else if (sKey = 'ｴｽｹｰﾌﾟ') or (sKey = 'ESC') or (sKey = 'ESCAPE') then begin FiVKeyCode := VK_ESCAPE; ls_Item := 'Escキー'; end else if (sKey = 'F1') then begin FiVKeyCode := VK_F1; end else if (sKey = 'F2') then begin FiVKeyCode := VK_F2; end else if (sKey = 'F3') then begin FiVKeyCode := VK_F3; end else if (sKey = 'F4') then begin FiVKeyCode := VK_F4; end else if (sKey = 'F5') then begin FiVKeyCode := VK_F5; end else if (sKey = 'F6') then begin FiVKeyCode := VK_F6; end else if (sKey = 'F7') then begin FiVKeyCode := VK_F7; end else if (sKey = 'F8') then begin FiVKeyCode := VK_F8; end else if (sKey = 'F9') then begin FiVKeyCode := VK_F9; end else if (sKey = 'F10') then begin FiVKeyCode := VK_F10; end else if (sKey = 'F11') then begin FiVKeyCode := VK_F11; end else if (sKey = 'F12') then begin FiVKeyCode := VK_F12; end; li_Index := lstHotKey.Items.IndexOf(ls_Item); lstHotKey.ItemIndex := li_Index; mniCapture_HotKey.Items[li_Index].Checked := True; mnuToolHotKey. Items[li_Index].Checked := True; end; procedure TApp_TOOLDskCapt.lstHotKeySelect(Sender: TObject); var li_Index : Integer; begin if (Tag = 0) then begin Exit; end; li_Index := gfniNumLimit(lstHotKey.ItemIndex, 0, lstHotKey.Items.Count -1); FSetHotKey(lstHotKey.Items[li_Index]); end; procedure TApp_TOOLDskCapt.FOnSelectHotKey(Sender: TObject); var l_MenuItem : TMenuItem; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); l_MenuItem.Checked := True; FSetHotKey(lstHotKey.Items[l_MenuItem.MenuIndex]); end; //--- 背景色 ------------------------------------------------------------------- procedure TApp_TOOLDskCapt.FSetBGColor(sColor: WideString); var i, li_Index : Integer; l_Bitmap : TBitmap; l_clTransparent : TColor; begin sColor := gfnsStrToHalf(WideUpperCase(sColor)); sColor := gfnsStrReplace(sColor, '色', ''); if (sColor = 'ｶｽﾀﾑ...') or (sColor = 'ｶｽﾀﾑ') or (sColor = 'CUSTOM') then begin FclBGColor := lstBGColor.Colors[0]; end else if (sColor = '黒') or (sColor = 'CLBLACK') or (sColor = 'BLACK') then begin FclBGColor := $000000; end else if (sColor = '茶') or (sColor = 'CLMAROON') or (sColor = 'MAROON') then begin FclBGColor := $000080; end else if (sColor = '緑') or (sColor = 'CLGREEN') or (sColor = 'GREEN') then begin FclBGColor := $008000; end else if (sColor = 'ｵﾘｰﾌﾞ') or (sColor = 'CLOLIVE') or (sColor = 'OLIVE') then begin FclBGColor := $008080; end else if (sColor = '紺') or (sColor = 'CLNAVY') or (sColor = 'NAVY') then begin FclBGColor := $800000; end else if (sColor = '紫') or (sColor = 'CLPURPLE') or (sColor = 'PURPLE') then begin FclBGColor := $800080; end else if (sColor = '青緑') or (sColor = 'CLTEAL') or (sColor = 'TEAL') then begin FclBGColor := $808000; end else if (sColor = '暗い灰') or (sColor = '暗灰') or (sColor = '灰') or (sColor = 'ｸﾞﾚｲ') or (sColor = 'CLGRAY') or (sColor = 'GRAY') then begin FclBGColor := $808080; end else if (sColor = '銀') or (sColor = 'ｼﾙﾊﾞｰ') or (sColor = 'CLSILVER') or (sColor = 'SILVER') then begin FclBGColor := $C0C0C0; end else if (sColor = '赤') or (sColor = 'CLRED') or (sColor = 'RED') then begin FclBGColor := $0000FF; end else if (sColor = 'ﾗｲﾑ') or (sColor = 'CLLIME') or (sColor = 'LIME') then begin FclBGColor := $00FF00; end else if (sColor = '黄') or (sColor = 'CLYELLOW') or (sColor = 'YELLOW') then begin FclBGColor := $00FFFF; end else if (sColor = '青') or (sColor = 'CLBLUE') or (sColor = 'BLUE') then begin FclBGColor := $FF0000; end else if (sColor = '赤紫') or (sColor = 'CLFUCHSIA') or (sColor = 'FUCHSIA') then begin FclBGColor := $FF00FF; end else if (sColor = '水') or (sColor = 'CLAQUA') or (sColor = 'AQUA') then begin FclBGColor := $FFFF00; end else if (sColor = '白') or (sColor = 'CLWHITE') or (sColor = 'WHITE') then begin FclBGColor := $FFFFFF; end else begin sColor := Trim(sColor); if (sColor[1] = '#') then begin sColor[1] := '$'; end; FclBGColor := TColor(gfniStrToInt(sColor)); end; li_Index := 0; for i := lstBGColor.Items.Count-1 downto 0 do begin if (lstBGColor.Colors[i] = FclBGColor) then begin li_Index := i; Break; end; end; l_Bitmap := TBitmap.Create; try l_Bitmap.Width := ImageList_Icon.Width; l_Bitmap.Height := ImageList_Icon.Height; with l_Bitmap.Canvas do begin if (FclBGColor = clFuchsia) then begin //背景色が赤紫だったら抜き色を黄色にする l_clTransparent := clYellow; end else begin //デフォルトの抜き色 l_clTransparent := clFuchsia; end; Brush.Color := l_clTransparent; FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height)); Brush.Color := clBlack; FillRect(Rect(1, 1, l_Bitmap.Width -2, l_Bitmap.Height -2)); if (FclBGColor <> clBlack) then begin Brush.Color := FclBGColor; FillRect(Rect(2, 2, l_Bitmap.Width -3, l_Bitmap.Height -3)); end; end; ImageList_Icon.ReplaceMasked(actCapture_BGColor.ImageIndex, l_Bitmap, l_clTransparent); finally l_Bitmap.Free; end; lstBGColor.ItemIndex := li_Index; mniCapture_BGColor.Items[li_Index].Checked := True; mnuToolBGColor. Items[li_Index].Checked := True; end; procedure TApp_TOOLDskCapt.lstBGColorSelect(Sender: TObject); var li_Index : Integer; begin if (Tag = 0) then begin Exit; end; li_Index := lstBGColor.ItemIndex; FSetBGColor(lstBGColor.Items[li_Index]); end; procedure TApp_TOOLDskCapt.FOnSelectBGColor(Sender: TObject); var l_MenuItem : TMenuItem; li_Index : Integer; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := TMenuItem(Sender); l_MenuItem.Checked := True; li_Index := l_MenuItem.MenuIndex; if (li_Index = 0) then begin lstBGColor.PickCustomColor; end; FSetBGColor(lstBGColor.Items[li_Index]); end; //------------------------------------------------------------------------------ procedure TApp_TOOLDskCapt.actNop(Sender: TObject); begin // end; procedure TApp_TOOLDskCapt.Action_File_SaveAsExecute(Sender: TObject); //名前をつけて保存 begin if (actCapture_StartStop.Tag <> 0) then begin actCapture_StartStopExecute(nil); end; if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actFile_SaveAsExecute(nil); end; end; procedure TApp_TOOLDskCapt.Action_File_ExitExecute(Sender: TObject); //終了 begin Close; end; //--- 編集 --------------------------------------------------------------------- procedure TApp_TOOLDskCapt.actEdit_UndoExecute(Sender: TObject); //元に戻す begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_UndoExecute(nil); end; end; procedure TApp_TOOLDskCapt.actEdit_RedoExecute(Sender: TObject); //やり直し begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_RedoExecute(nil); end; end; procedure TApp_TOOLDskCapt.actEdit_CopyExecute(Sender: TObject); //コピー begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_CopyExecute(nil); end; end; procedure TApp_TOOLDskCapt.actEdit_CutExecute(Sender: TObject); //切り取り begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_CutExecute(nil); end; end; procedure TApp_TOOLDskCapt.actEdit_PasteExecute(Sender: TObject); //貼り付け(挿入) begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_PasteExecute(FGetCaptWindow.actEdit_Paste); end; end; procedure TApp_TOOLDskCapt.actEdit_ReplaceExecute(Sender: TObject); //置き換え begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_PasteExecute(FGetCaptWindow.actEdit_Replace); end; end; procedure TApp_TOOLDskCapt.actEdit_DelExecute(Sender: TObject); //削除 begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actEdit_DelExecute(nil); end; end; //--- フレーム ----------------------------------------------------------------- procedure TApp_TOOLDskCapt.actFrame_BackExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actFrame_BackExecute(FGetCaptWindow.actFrame_Back); end; end; procedure TApp_TOOLDskCapt.actFrame_NextExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actFrame_BackExecute(FGetCaptWindow.actFrame_Next); end; end; procedure TApp_TOOLDskCapt.actFrame_HeadExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actFrame_BackExecute(FGetCaptWindow.actFrame_Head); end; end; procedure TApp_TOOLDskCapt.actFrame_EndExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actFrame_BackExecute(FGetCaptWindow.actFrame_End); end; end; //--- ヘルプ ------------------------------------------------------------------- procedure TApp_TOOLDskCapt.actHelp_VersionInfoExecute(Sender: TObject); // begin gpcVersionInfoCreate; // gpcVersionInfoMemoSet(gfnsVersionInfoMemoGet + #13#13 + edtHelp.Text); gpcVersionInfoURLSet('http://drang.s4.xrea.com/program/tool/tool/dskcapt/help/'); gpcVersionInfoShowModal; gpcVersionInfoRelease; end; //actProgram_RunExecute -------------------------------------------------------- var lsProgramFile : WideString; lbProgramDone : Boolean; lhTargetHandle : HWND; lbIsIconic : Boolean; function ForegroundEnumWindowProc(hHandle: HWND; iLParam: LPARAM): BOOL; stdcall; begin Result := True; if (WideUpperCase(gfnsExeNameGet(hHandle)) = lsProgramFile) then begin //実行ファイルの名前が同じだった。 lhTargetHandle := hHandle; if (IsIconic(hHandle)) then begin lbIsIconic := True; Result := False; end; end; end; procedure TApp_TOOLDskCapt.actProgram_RunExecute(Sender: TObject); var ls_Exe : WideString; begin // if (Sender is TMenuItem) then begin //「ファイル」→「プログラム」→「実行」のサブメニューから呼ばれた。 ls_Exe := TMenuItem(Sender).Hint; end else begin //プログラムリストから選択。 if (lstProgram.ItemIndex < 0) then begin Exit; end; ls_Exe := lstProgram.Items[lstProgram.ItemIndex]; end; if not(gfnbFileExists(ls_Exe)) then begin Exit; end; // Beep; lbProgramDone := False; if (actProgram_Foreground.Checked) then begin //既に実行済みなら新規に実行はせず前面に移動させるだけ if (gfnbIsShortCut(ls_Exe)) then begin lsProgramFile := gfnsLinkToFile(ls_Exe); end else begin lsProgramFile := ls_Exe; end; lsProgramFile := WideUpperCase(lsProgramFile); lhTargetHandle := 0; lbIsIconic := False; EnumWindows(@ForegroundEnumWindowProc, 0); if (lhTargetHandle <> 0) then begin if (lbIsIconic) then begin //最小化されていたら元に戻す。 SendMessage(lhTargetHandle, WM_SYSCOMMAND, WPARAM(SC_RESTORE and $FFF0), 0); end; //前面に移動させる。 SetForegroundWindow(lhTargetHandle); //前面に移動させたので新規に実行する必要はない lbProgramDone := True; end; end; if not(lbProgramDone) then begin //新規実行 gpcQuoatExecute(ls_Exe); end; end; procedure TApp_TOOLDskCapt.actProgram_DelExecute(Sender: TObject); var li_Index : Integer; ls_Name : WideString; begin // if (Sender is TMenuItem) then begin li_Index := TMenuItem(Sender).MenuIndex; end else begin li_Index := lstProgram.ItemIndex; end; if (li_Index >= 0) then begin ls_Name := gfnsFileNameGet(lstProgram.Items[li_Index]); if (gfniMessageBoxYesNo(WideFormat('%s'#13'をリストから削除しますか', [ls_Name])) = ID_YES) then begin lstProgram.Items. Delete(li_Index); ImageList_Program.Delete(li_Index); end; end; FCreateProgramMenu; end; procedure TApp_TOOLDskCapt.actProgram_AddExecute(Sender: TObject); var i : Integer; ls_File : WideString; ls_Name : WideString; ls_IniDir : WideString; l_Bitmap : TBitmap; begin ls_IniDir := Dialog_Program.InitialDir; if (gfnbKeyState(VK_SHIFT)) then begin Dialog_Program.InitialDir := gfnsProgramFilesPathGet; end; if (Dialog_Program.Execute) then begin Dialog_Program.InitialDir := gfnsFilePathGet(Dialog_Program.FileName); ls_File := WideUpperCase(Dialog_Program.FileName); for i := 0 to lstProgram.Items.Count-1 do begin if (WideUpperCase(lstProgram.Items[i]) = ls_File) then begin ls_Name := gfnsFileNameGet(Dialog_Program.FileName); gpcShowMessage(WideFormat('%s'#13'は登録済みです', [ls_Name])); Exit; end; end; lstProgram.Items.Add(Dialog_Program.FileName); l_Bitmap := TBitmap.Create; try gpcProgramIconAdd(ImageList_Program, Dialog_Program.FileName); finally l_Bitmap.Free; end; end else begin Dialog_Program.InitialDir := ls_IniDir; end; FCreateProgramMenu; end; procedure TApp_TOOLDskCapt.WndProc(var Msg: TMessage); begin if (Self.Menu <> nil) and (Msg.Msg = WM_INITMENU) and (Msg.WParam = WPARAM(Self.Menu.Handle)) then begin Menu_ProgramPopup(nil); end; inherited WndProc(Msg); end; procedure TApp_TOOLDskCapt.Menu_ProgramPopup(Sender: TObject); begin actProgram_Del.Enabled := (lstProgram.Items.Count > 0); actProgram_ListDel.Enabled := (lstProgram.ItemIndex >= 0); actProgram_Run.Enabled := actProgram_ListDel.Enabled and gfnbFileExists(lstProgram.Items[lstProgram.ItemIndex]); end; procedure TApp_TOOLDskCapt.lstProgramDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const lci_MARGIN = 2; var lrc_Rect : TRect; li_Width, li_Height : Integer; ls_File, ls_Name : WideString; l_Bitmap : TBitmap; begin lrc_Rect := Rect; li_Height := gfniRectHeight(Rect); li_Width := li_Height; with lstProgram.Canvas do begin FillRect(lrc_Rect); l_Bitmap := TBitmap.Create; try l_Bitmap.Width := ImageList_Program.Width; l_Bitmap.Height := ImageList_Program.Height; ImageList_Program.GetBitmap(Index, l_Bitmap); BitBlt(Handle, Rect.Left + (li_Width - l_Bitmap.Width) div 2, Rect.Top + (li_Height - l_Bitmap.Height) div 2, l_Bitmap.Width, l_Bitmap.Height, l_Bitmap.Canvas.Handle, 0, 0, SRCCOPY); finally l_Bitmap.Free; end; Inc(lrc_Rect.Left, li_Width + lci_MARGIN); //DrawTextWに渡す文字列に処理に時間がかかる関数を渡すと挙動がおかしくなるので予め処理しておく。 ls_File := lstProgram.Items[Index]; ls_Name := gfnsFileNameGet(ls_File); // if not(gfnbFileExists(ls_File)) then begin // Font.Style := Font.Style + [fsStrikeOut]; // end; DrawTextW(Handle, PWideChar(ls_Name), -1, lrc_Rect, DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE); end; end; procedure TApp_TOOLDskCapt.lstProgramClick(Sender: TObject); begin if (lstProgram.ItemIndex >= 0) then begin lstProgram.Hint := lstProgram.Items[lstProgram.ItemIndex]; end else begin lstProgram.Hint := ''; end; end; procedure TApp_TOOLDskCapt.FCreateProgramMenu; procedure _CreatePrgMenu(AMenuItem : TMenuItem; AOnClick : TNotifyEvent); var i : Integer; ls_Name : String; l_MenuItem : TMenuItem; begin for i := 0 to lstProgram.Count-1 do begin //頭に'__'をつけることでメニューカスタマイズから除外する ls_Name := gfnsAvailableName(Format('__%s', [AMenuItem.Name])); l_MenuItem := NewItem( gfnsFileNameGet(lstProgram.Items[i]), //Caption 0, //ShortCut False, //Checked True, //Enabled AOnClick, //OnClickイベント 0, //HelpContext ls_Name //Name ); l_MenuItem.Hint := lstProgram.Items[i]; l_MenuItem.OnDrawItem := mniProgram_RunDrawItem; AMenuItem.Add(l_MenuItem); end; end; begin myMenu.gpcMenuItemFree(mniProgram, mniProgram_Line2.MenuIndex +1); myMenu.gpcMenuItemFree(mnuToolProgram); myMenu.gpcMenuItemFree(mniProgram_Del); myMenu.gpcMenuItemFree(Menu_Program_Del); _CreatePrgMenu(mniProgram, actProgram_RunExecute); _CreatePrgMenu(mnuToolProgram.Items, actProgram_RunExecute); _CreatePrgMenu(mniProgram_Del, actProgram_DelExecute); _CreatePrgMenu(Menu_Program_Del.Items, actProgram_DelExecute); end; //------------------------------------------------------------------------------ //IniFile const lcsSECT_BOUNDS = 'Bounds'; lcsSECT_FILE = 'File'; lcsKEY_GIFTRANSPARENT = 'GIFTransparent'; lcsSECT_CAPTURE = 'Capture'; lcsKEY_OBJECT = 'Object'; lcsKEY_HOTKEY = 'HotKey'; lcsKEY_BGCOLOR = 'BGColor'; lcsKEY_CUSTOMCOLOR = 'CustomColor'; lcsKEY_AREAWINDOW = 'AreaWindow'; lcsKEY_PRINTWINDOW = 'PrintWindow'; lcsKEY_MOUSECURSOR = 'MouseCursor'; lcsKEY_MULTICAPTURE = 'MultiCapture'; lcsKEY_SEQUENCECAPTURE = 'SequenceCapture'; lcsKEY_INTERVALCAPTURE = 'IntervalCapture'; lcsKEY_ACTIVEWINDOW = 'ActiveWindow'; lcsSECT_PROGRAM = 'Program'; lcsKEY_FOREGROUND = 'Foreground'; lcsSECT_PROGRAMLIST = 'ProgramList'; lcsSECT_DIALOG = 'Dialog'; lcsKEY_DLGSAVEPATH = 'SavePath'; lcsKEY_DLGSAVEINDEX = 'SaveFilterIndex'; lcsKEY_DLGSELPRGPATH = 'SelProgramPath'; lcsSECT_ZOOM = 'Zoom'; lcsKEY_ZOOMALWAYSFIT = 'AlwaysFit'; lcsKEY_ZOOMSMOOTH = 'Smooth'; lcsSECT_OPT = 'Option'; lcsKEY_DISPTOOLBAR = 'ToolBar'; lcsKEY_DISPCTRLPANEL = 'ControlPanel'; lcsSECT_WINDOW = 'Window'; lcsKEY_CONFIRMSAVE = 'ConfirmSave'; function TApp_TOOLDskCapt.FLoadIni: Boolean; const lci_MINWIDTH = 32; lci_MINHEIGHT = 32; var l_IniFile : TMyIniFile; i : Integer; begin Result := False; FrcArea := Rect(0, 0, 320, 240); //デフォルト値 //Shift+Ctrl起動で設定を読み込まない。 if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try //------------------------------------------------------------------------------ //準汎用フォーム用 App_CustomToolBar.ReadIniToolBar(l_IniFile, [ToolBar_Main]); //------------------------------------------------------------------------------ SetMonitorBoundsRect(Self); //[File] Action_File_GifTransparent.Checked := ReadBool(lcsSECT_FILE, lcsKEY_GIFTRANSPARENT, Action_File_GifTransparent.Checked); //[Capture] grpObject.ItemIndex := gfniNumLimit(ReadInteger(lcsSECT_CAPTURE, lcsKEY_OBJECT, grpObject.ItemIndex), 0, grpObject.Items.Count-1); lstHotKey.ItemIndex := gfniNumLimit(ReadInteger(lcsSECT_CAPTURE, lcsKEY_HOTKEY, lstHotKey.ItemIndex), 0, lstHotKey.Items.Count-1); lstBGColor.ItemIndex := gfniNumLimit(ReadInteger(lcsSECT_CAPTURE, lcsKEY_BGCOLOR, lstBGColor.ItemIndex), 0, lstBGColor.Items.Count-1); lstBGColor.Items.Objects[0] := TObject(ReadInteger(lcsSECT_CAPTURE, lcsKEY_CUSTOMCOLOR, lstBGColor.Colors[0])); FSetBGColor(lstBGColor.Items[lstBGColor.ItemIndex]); FrcArea := ReadRect(lcsSECT_CAPTURE, lcsKEY_AREAWINDOW, FrcArea); if (gfniRectWidth(FrcArea) < lci_MINWIDTH) then begin FrcArea := gfnrcRectWidthSet(FrcArea, lci_MINWIDTH); end; if (gfniRectHeight(FrcArea) < lci_MINHEIGHT) then begin FrcArea := gfnrcRectHeightSet(FrcArea, lci_MINHEIGHT); end; actCapture_ActiveWindow.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_ACTIVEWINDOW, actCapture_ActiveWindow.Checked); actCapture_PrintWindow.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_PRINTWINDOW, actCapture_PrintWindow.Checked); actCapture_MouseCursor.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_MOUSECURSOR, actCapture_MouseCursor.Checked); actCapture_Multi.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_MULTICAPTURE, actCapture_Multi.Checked); actCapture_Sequence.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_SEQUENCECAPTURE, actCapture_Sequence.Checked); actCapture_Interval.Checked := ReadBool(lcsSECT_CAPTURE, lcsKEY_INTERVALCAPTURE, actCapture_Interval.Checked); //[Program] actProgram_Foreground.Checked := ReadBool(lcsSECT_PROGRAM, lcsKEY_FOREGROUND, actProgram_Foreground.Checked); //[ProgramList] ReadSectionText(lcsSECT_PROGRAMLIST, lstProgram.Items); for i := 0 to lstProgram.Count-1 do begin gpcProgramIconAdd(ImageList_Program, lstProgram.Items[i]); end; FCreateProgramMenu; //[Dialog] Dialog_File_SaveAs.InitialDir := ReadString (lcsSECT_DIALOG, lcsKEY_DLGSAVEPATH, Dialog_File_SaveAs.InitialDir); Dialog_File_SaveAs.FilterIndex := ReadInteger(lcsSECT_DIALOG, lcsKEY_DLGSAVEINDEX, Dialog_File_SaveAs.FilterIndex); Dialog_Program.InitialDir := ReadString (lcsSECT_DIALOG, lcsKEY_DLGSELPRGPATH, Dialog_Program.InitialDir); //[Window] actWindow_ConfirmSave.Checked := ReadBool(lcsSECT_WINDOW, lcsKEY_CONFIRMSAVE, actWindow_ConfirmSave.Checked); //[Zoom] Action_ZoomAlwaysFit.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMALWAYSFIT, Action_ZoomAlwaysFit.Checked); Action_ZoomSmooth.Checked := ReadBool(lcsSECT_ZOOM, lcsKEY_ZOOMSMOOTH, Action_ZoomSmooth.Checked); //[Option] actDisp_ToolBar.Checked := ReadBool(lcsSECT_OPT, lcsKEY_DISPTOOLBAR, actDisp_ToolBar.Checked); actDisp_CtrlPanel.Checked := ReadBool(lcsSECT_OPT, lcsKEY_DISPCTRLPANEL, actDisp_CtrlPanel.Checked); actDisp_ToolBarExecute (nil); actDisp_CtrlPanelExecute(nil); finally Free; end; end; Result := True; end; //設定保存 procedure TApp_TOOLDskCapt.FSaveIni; var l_IniFile : TMyIniFile; begin //Shift+Ctrl起動で設定を書き込まない。 if (gfnbKeyState(VK_SHIFT) and gfnbKeyState(VK_CONTROL)) then begin Exit; end; l_IniFile := TMyIniFile.Create; with l_IniFile do begin try WriteBoundsRect(Self); //[File] WriteBool(lcsSECT_FILE, lcsKEY_GIFTRANSPARENT, Action_File_GifTransparent.Checked); //[Capture] WriteInteger(lcsSECT_CAPTURE, lcsKEY_OBJECT, grpObject.ItemIndex); WriteInteger(lcsSECT_CAPTURE, lcsKEY_HOTKEY, lstHotKey.ItemIndex); WriteInteger(lcsSECT_CAPTURE, lcsKEY_BGCOLOR, lstBGColor.ItemIndex); WriteInteger(lcsSECT_CAPTURE, lcsKEY_CUSTOMCOLOR, lstBGColor.Colors[0]); WriteRect (lcsSECT_CAPTURE, lcsKEY_AREAWINDOW, FrcArea); WriteBool (lcsSECT_CAPTURE, lcsKEY_ACTIVEWINDOW, actCapture_ActiveWindow.Checked); WriteBool (lcsSECT_CAPTURE, lcsKEY_PRINTWINDOW, actCapture_PrintWindow.Checked); WriteBool (lcsSECT_CAPTURE, lcsKEY_MOUSECURSOR, actCapture_MouseCursor.Checked); WriteBool (lcsSECT_CAPTURE, lcsKEY_MULTICAPTURE, actCapture_Multi.Checked); WriteBool (lcsSECT_CAPTURE, lcsKEY_SEQUENCECAPTURE, actCapture_Sequence.Checked); WriteBool (lcsSECT_CAPTURE, lcsKEY_INTERVALCAPTURE, actCapture_Interval.Checked); //[Program] WriteBool(lcsSECT_PROGRAM, lcsKEY_FOREGROUND, actProgram_Foreground.Checked); //[ProgramList] WriteSectionText(lcsSECT_PROGRAMLIST, lstProgram.Items); //[Dialog] WriteString (lcsSECT_DIALOG, lcsKEY_DLGSAVEPATH, Dialog_File_SaveAs.InitialDir); WriteInteger(lcsSECT_DIALOG, lcsKEY_DLGSAVEINDEX, Dialog_File_SaveAs.FilterIndex); WriteString (lcsSECT_DIALOG, lcsKEY_DLGSELPRGPATH, Dialog_Program.InitialDir); //[Window] WriteBool(lcsSECT_WINDOW, lcsKEY_CONFIRMSAVE, actWindow_ConfirmSave.Checked); //[Zoom] WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMALWAYSFIT, Action_ZoomAlwaysFit.Checked); WriteBool(lcsSECT_ZOOM, lcsKEY_ZOOMSMOOTH, Action_ZoomSmooth.Checked); //[Option] WriteBool(lcsSECT_OPT, lcsKEY_DISPTOOLBAR, actDisp_ToolBar.Checked); WriteBool(lcsSECT_OPT, lcsKEY_DISPCTRLPANEL, actDisp_CtrlPanel.Checked); //------------------------------------------------------------------------------ //準汎用フォーム用 //[ToolBar] gpcWriteIniToolBar(l_IniFile, [ToolBar_Main]); //------------------------------------------------------------------------------ try UpdateFile; except end; finally Free; end; end; end; //--- メニュー表示 ------------------------------------------------------------- procedure TApp_TOOLDskCapt.mniFileAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); begin myMenu.MenuItem_AdvancedDrawItem(Sender, ACanvas, ARect, State); end; procedure TApp_TOOLDskCapt.mniProgram_RunDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); begin myMenu.MenuItem_SendToDrawItem(Sender, ACanvas, ARect, Selected); end; //--- ウィンドウ --------------------------------------------------------------- procedure TApp_TOOLDskCapt.actWindow_CascadeExecute(Sender: TObject); //重ねて表示 begin Self.Cascade; end; procedure TApp_TOOLDskCapt.actWindow_TileLeftRightExecute(Sender: TObject); //上下に並べて表示 begin Self.TileMode := tbVertical; Self.Tile; end; procedure TApp_TOOLDskCapt.actWindow_TileTopBottomExecute(Sender: TObject); //左右に並べて表示 begin Self.TileMode := tbHorizontal; Self.Tile; end; procedure TApp_TOOLDskCapt.actWindow_CloseAllExecute(Sender: TObject); //すべて閉じる var i : Integer; begin for i := Screen.FormCount-1 downto 0 do begin if (Screen.Forms[i] is TApp_TOOLDskCaptWindow) then begin TApp_TOOLDskCaptWindow(Screen.Forms[i]).Close; end; end; end; procedure TApp_TOOLDskCapt.mniWindowClick(Sender: TObject); //ウィンドウ選択 var i : Integer; l_MenuItem : TMenuItem; l_Child : TApp_TOOLDskCaptWindow; begin if not(Sender is TMenuItem) then begin Exit; end; l_MenuItem := Sender as TMenuItem; for i := 0 to Self.MDIChildCount-1 do begin l_Child := TApp_TOOLDskCaptWindow(Self.MDIChildren[i]); if (l_Child.Handle = HWND(l_MenuItem.Tag)) then begin l_MenuItem.Checked := True; l_Child.BringToFront; if (l_Child.CanFocus) then begin l_Child.SetFocus; Exit; end; end; end; end; //------------------------------------------------------------------------------ //ズーム procedure TApp_TOOLDskCapt.Action_ZoomAlwaysFitExecute(Sender: TObject); //常にウィンドウサイズに合わせて表示 begin if (FGetCaptWindow <> nil) and (Action_ZoomAlwaysFit.Checked) then begin FGetCaptWindow.FormResize(nil); end; end; procedure TApp_TOOLDskCapt.actZoom_FitExecute(Sender: TObject); //ウィンドウサイズに合わせる begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actZoom_UpExecute(FGetCaptWindow.actZoom_Fit); end; end; procedure TApp_TOOLDskCapt.actZoom_100Execute(Sender: TObject); //実寸表示 begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actZoom_UpExecute(FGetCaptWindow.actZoom_100); end; end; procedure TApp_TOOLDskCapt.actZoom_UpExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actZoom_UpExecute(FGetCaptWindow.actZoom_Up); end; end; procedure TApp_TOOLDskCapt.actZoom_DownExecute(Sender: TObject); begin if (FGetCaptWindow <> nil) then begin FGetCaptWindow.actZoom_UpExecute(FGetCaptWindow.actZoom_Down); end; end; //--- 表示 --------------------------------------------------------------------- procedure TApp_TOOLDskCapt.actDisp_ToolBarExecute(Sender: TObject); //ツールバー begin ToolBar_Main.Visible := actDisp_ToolBar.Checked; end; procedure TApp_TOOLDskCapt.actDisp_CtrlPanelExecute(Sender: TObject); //コントロールボタンパネル begin Panel_Cmd.Visible := actDisp_CtrlPanel.Checked; end; function TApp_TOOLDskCapt.FGetWorkareaWidth: Integer; begin Result := Self.ClientWidth; end; function TApp_TOOLDskCapt.FGetWorkareaHeight: Integer; begin Result := ClientHeight; if (ToolBar_Main.Visible) then begin Dec(Result, ToolBar_Main.Height); end; if (Panel_Cmd.Visible) then begin Dec(Result, Panel_Cmd.Height); end; end; procedure TApp_TOOLDskCapt.FCreateAreaWindow; var lh_Process : THandle; begin if (FIsExistAreaWindow) then begin FShowAreaWindow; Exit; end; lh_Process := gfnhQuoatExecute(gfnsExeNameGet, WideFormat('/area_window:%d', [MessagePanel.Handle])); try //これがないとタイミングの問題でウィンドウハンドルを取得できない WaitForInputIdle(lh_Process, 2000); FhAreaMessage := FGetAreaMessageWindow; finally CloseHandle(lh_Process); end; end; procedure TApp_TOOLDskCapt.actCapture_AreaExecute(Sender: TObject); begin FDoCapture; end; procedure TApp_TOOLDskCapt.actCustom_ToolBarExecute(Sender: TObject); //カスタム/ツールバー begin gpcCreateToolBarForm(Self); App_CustomToolBar.Show; end; procedure TApp_TOOLDskCapt.actCapture_SequenceExecute(Sender: TObject); //連続キャプチャ //一つのウィンドウを作成しそのフレームにキャプチャ画像を順次入れる //AVIやアニメーションGIF、連番出力向け begin FIntervalCapt := nil; FCaptWindow := nil; if (actCapture_Sequence.Checked) then begin actCapture_Multi.Checked := False; end; end; procedure TApp_TOOLDskCapt.actCapture_MultiExecute(Sender: TObject); //複数キャプチャ //一つのキャプチャ画像につき一つウィンドウを作成する begin if (actCapture_Multi.Checked) then begin actCapture_Sequence.Checked := False; end; end; procedure TApp_TOOLDskCapt.Action_File_SaveBmpExecute(Sender: TObject); begin // if (Sender = Action_File_SaveJpeg) then begin Dialog_File_SaveAs.FilterIndex := G_ciFILESAVE_JPEG; end else if (Sender = Action_File_SaveGif) then begin Dialog_File_SaveAs.FilterIndex := G_ciFILESAVE_GIF; end else if (Sender = Action_File_SaveGifAnime) then begin Dialog_File_SaveAs.FilterIndex := G_ciFILESAVE_GIFANIME; end else if (Sender = Action_File_SaveAvi) then begin Dialog_File_SaveAs.FilterIndex := G_ciFILESAVE_AVI; end else begin //デフォルトはBMP Dialog_File_SaveAs.FilterIndex := G_ciFILESAVE_BMP; end; Action_File_SaveAsExecute(nil); end; procedure TApp_TOOLDskCapt.Action_Opt_AeroThemeOnOffExecute(Sender: TObject); var lb_Aero : BOOL; li_Ret : HResult; begin DwmIsCompositionEnabled(lb_Aero); if (lb_Aero) then begin li_Ret := DwmEnableComposition(DWM_EC_DISABLECOMPOSITION); end else begin li_Ret := DwmEnableComposition(DWM_EC_ENABLECOMPOSITION); end; Beep; end; procedure TApp_TOOLDskCapt.Action_Opt_LargeIconExecute(Sender: TObject); const lci_LARGE_ICON_SIZE = 32; lci_SMALL_ICON_SIZE = 16; var i : Integer; l_Bitmap : TBitmap; li_Count : Integer; begin if (Action_Opt_LargeIcon.Checked) then begin if (ImageList_Icon.Width = lci_LARGE_ICON_SIZE) and (ImageList_Icon.Height = lci_LARGE_ICON_SIZE) then begin Exit; end; if (FBitmap_ImageList = nil) then begin FBitmap_ImageList := TBitmap.Create; FBitmap_ImageList.Height := ImageList_Icon.Height; FBitmap_ImageList.Width := ImageList_Icon.Width * ImageList_Icon.Count; l_Bitmap := TBitmap.Create; try l_Bitmap.Width := ImageList_Icon.Width; l_Bitmap.Height := ImageList_Icon.Height; l_Bitmap.Canvas.Brush.Color := clFuchsia; for i := 0 to ImageList_Icon.Count -1 do begin l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height)); ImageList_Icon.GetBitmap(i, l_Bitmap); BitBlt( FBitmap_ImageList.Canvas.Handle, i * l_Bitmap.Width, 0, l_Bitmap.Width, l_Bitmap.Height, l_Bitmap.Canvas.Handle, 0, 0, SRCCOPY ); end; finally l_Bitmap.Free; end; end; end; if not(Action_Opt_LargeIcon.Checked) then begin if (ImageList_Icon.Width = lci_SMALL_ICON_SIZE) and (ImageList_Icon.Height = lci_SMALL_ICON_SIZE) then begin Exit; end; end; li_Count := ImageList_Icon.Count; l_Bitmap := TBitmap.Create; try ImageList_Icon.Clear; if (Action_Opt_LargeIcon.Checked) then begin ImageList_Icon.Width := lci_LARGE_ICON_SIZE; ImageList_Icon.Height := lci_LARGE_ICON_SIZE; end else begin ImageList_Icon.Width := lci_SMALL_ICON_SIZE; ImageList_Icon.Height := lci_SMALL_ICON_SIZE; end; l_Bitmap.Width := ImageList_Icon.Width; l_Bitmap.Height := ImageList_Icon.Height; l_Bitmap.Canvas.Brush.Color := clFuchsia; for i := 0 to li_Count -1 do begin if (ImageList_Icon.Height mod FBitmap_ImageList.Height <> 0) then begin SetStretchBltMode(l_Bitmap.Canvas.Handle, HALFTONE); SetBrushOrgEx(l_Bitmap.Canvas.Handle, 0, 0, nil); end; l_Bitmap.Canvas.FillRect(Rect(0, 0, l_Bitmap.Width, l_Bitmap.Height)); StretchBlt( l_Bitmap.Canvas.Handle, 0, 0, l_Bitmap.Width, l_Bitmap.Height, FBitmap_ImageList.Canvas.Handle, i * FBitmap_ImageList.Width div li_Count, 0, FBitmap_ImageList.Width div li_Count, FBitmap_ImageList.Height, SRCCOPY ); ImageList_Icon.AddMasked(l_Bitmap, clFuchsia); end; finally l_Bitmap.Free; end; gpcToolBarResize(ToolBar_Main); end; procedure TApp_TOOLDskCapt.Dialog_File_SaveAsTypeChange(Sender: TObject); begin Beep; end; end.