MX Component を使わない PLC I/O チェッカーたたき台 (2019/03/28)
GX Works2 のデバイス一括モニタの画面を表示させたままで使います。
姑息な方法ながら、何とか実用になりそうです。いずれ FX (8進数アドレス)にも対応予定です。
あと Bluetooth 端末からのコマンド受信、応答を追加すればスマホから I/O チェックができるようになります。
unit GXW2Unit4; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Buttons; type TBitAry = array [0..159] of Boolean; type TForm4 = class(TForm) Edit1: TEdit; Image1: TImage; Button3: TButton; Timer1: TTimer; Edit2: TEdit; Edit3: TEdit; SpeedButton1: TSpeedButton; SpeedButton2: TSpeedButton; Edit4: TEdit; Button4: TButton; Label1: TLabel; SpeedButton3: TSpeedButton; SpeedButton4: TSpeedButton; Button1: TButton; Edit5: TEdit; SpeedButton5: TSpeedButton; SpeedButton6: TSpeedButton; SpeedButton7: TSpeedButton; SpeedButton8: TSpeedButton; SpeedButton9: TSpeedButton; SpeedButton10: TSpeedButton; procedure Button3Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button4Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton7Click(Sender: TObject); procedure SpeedButton9Click(Sender: TObject); procedure SpeedButton10Click(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private 宣言 } public { Public 宣言 } end; var Form4: TForm4; // SpreadSheet ウィンドウ SpreadSheetHwnd : HWND; // SpreadSheet ウィンドウの左上座標 shtCaptLeft, shtCaptTop : integer; // 座標補正の係数 shtXScale, shtYScale : double; // 列幅、行高 shtColWidth, shtRowHeight : double; pickXOff, pickYOff : integer; DeviceEditHwnd : HWND; DeviceComboHwnd : HWND; // メインウィンドウ GXW2FrameHwnd : HWND; BitAryNew : TBitAry; BitAryOld : TBitAry; devHeadOld : string; passFlag : boolean; implementation {$R *.dfm} //**************************************** // 画面の指定位置をBitmapに変換 //**************************************** procedure CaptureToBmp(Lf, Tp, W, H: Integer; bmp: TBitmap); const CAPTUREBLT = $40000000; var hdcScreen : HDC; begin bmp.Width := W; bmp.Height := H; hdcScreen := CreateDC('DISPLAY', nil, nil, nil); try BitBlt( bmp.Canvas.Handle, 0, 0, W, H, hdcScreen, Lf, Tp, SRCCOPY or CAPTUREBLT); finally DeleteDC(hdcScreen); end; end; //****************************************** // ウィンドウのタイトル(キャプション)を得る //****************************************** function GetWindowCaption(h : HWND) : string; var Title : array [0..255] of char; begin result := ''; if GetWindowText(h, Title, 255) <> 0 then result := Title; end; //****************************************** // 他のプロセス内のコントロールの文字列を得る //****************************************** function GetWindowString(h : HWND) : string; var p : PChar; len : LongInt; begin result := ''; //ウィンドウの文字列のバイト数を取得 //終端のNULL文字を含まない文字列の長さ(バイト数) len := SendMessage(h, WM_GETTEXTLENGTH, 0, 0); if len > 0 then begin //終端のNULL文字を含むサイズを確保 GetMem(p, (len + 1) * 2); //格納するバッファの最大サイズ(終端のNULL文字を含む長さ) //文字列バッファ SendMessage(h, WM_GETTEXT, (len+1)*2, LongInt(p)); //文字列がバッファサイズより長いとき、後部がカットされる result := string(p); FreeMem(p); end; end; function GetHwndClassName(h : HWND):string; var PC : PChar; Len : Integer; Classname : string; begin ClassName := ''; if not IsWindow(h) then exit; GetMem(PC, 100); try Len := GetClassName(h, PC, 100); SetString(Classname, PC, Len); finally FreeMem(PC); end; result := Classname; end; function EnumCWinProc_DeviceCombo(h: HWND; lparam: Integer): Bool; stdcall; var Title : array [0..255] of char; begin result := true; if GetWindowText(h, Title, 255) <> 0 then begin if Pos('デバイス/バッファメモリ一括モニタ', Title) = 1 then begin DeviceComboHwnd := h; Result := False; end; end; end; function EnumCWinProc_SpreadSheet(h: HWND; lparam: Integer): Bool; stdcall; var ClassName : string; begin result := true; ClassName := GetHwndClassName(h); if 'SPR32AU70_SpreadSheet' = ClassName then begin SpreadSheetHwnd := h; Result := False; end; end; // Window に文字列を送る function SendCharHwnd(h: HWND; const s: string):boolean; var i : integer; begin result := False; if h <> 0 then begin for i := 1 to Length(s) do SendMessage(h, WM_CHAR, Word(s[i]), 0); result := true; end; end; // Window に文字列を送る function SendTextHwnd(h: HWND; const s : string):boolean; begin result := False; if h <> 0 then begin SendMessage(h, WM_SETTEXT, 0, LPARAM(PChar(s))); result := true; end; end; procedure TForm4.Button1Click(Sender: TObject); // 先頭デバイス変更 var x, y : integer; pt, pt0 : TPoint; begin if IsWindowVisible(DeviceEditHwnd) then begin GetCursorPos(pt0); SendTextHwnd(DeviceEditHwnd, Trim(Edit5.Text)); SetForegroundWindow(DeviceEditHwnd); // [Enter] keybd_event(VK_RETURN, 0, 0, 0); keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0); // セル 0,0 に移動 x := shtCaptLeft + Trunc(15 * shtColWidth + pickXOff * shtXScale); y := shtCaptTop + Trunc(shtRowHeight + pickYOff * shtYScale); SetCursorPos(x, y); pt.X := x; pt.Y := y; // マウス直下の Window を取得 if WindowFromPoint(pt) = SpreadSheetHwnd then begin // マウスクリックで Active に mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0); mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); end; SetCursorPos(pt0.X, pt0.Y); end; end; procedure TForm4.Button3Click(Sender: TObject); var h : HWND; i, j, n : integer; ARect : TRect; bmp : TBitmap; Pnt : PByteArray; R, G, B : Byte; x, y : integer; pt : TPoint; begin // メインウィンドウを探す GXW2FrameHwnd := FindWindow('GXW2FrameWnd', nil); if IsWindowVisible(GXW2FrameHwnd) and not IsIconic(GXW2FrameHwnd) then begin //キャプション「デバイス/バッファメモリ一括モニタ」を探す EnumChildWindows(GXW2FrameHwnd, @EnumCwinProc_DeviceCombo, 0); h := GetWindow(DeviceComboHwnd, GW_CHILD); h := GetWindow(h, GW_CHILD); for i := 0 to 2 do h := GetWindow(h, GW_HWNDNEXT); DeviceEditHwnd := GetWindow(h, GW_CHILD); // デバイス先頭 Edit1.Text := GetWindowString(DeviceEditHwnd); if Edit4.Text = '' then Edit4.Text := Edit1.Text; if Edit5.Text = '' then Edit5.Text := Edit1.Text; // 先頭デバイスが変わったときは、1回パス if devHeadOld <> Edit1.Text then begin passFlag := True; devHeadOld := Edit1.Text; // 反転デバイスを変更 Edit4.Text := Edit1.Text; end else passFlag := False; // クラス名「SPR32AU70_SpreadSheet」 を探す EnumChildWindows(GXW2FrameHwnd, @EnumCwinProc_SpreadSheet, 0); GetWindowRect(SpreadSheetHwnd, ARect); // 左上座標を保持 shtCaptLeft := Trunc(ARect.Left + 243 * shtXScale); shtCaptTop := ARect.Top; shtColWidth := 504 * shtXScale / 16 ; // 16 列 shtRowHeight := 371 * shtYScale / 11 ; // 11 行 (タイトルを含む行数) // アクティブにする pt.X := shtCaptLeft; pt.Y := shtCaptTop; if WindowFromPoint(pt) <> SpreadSheetHwnd then begin SetForegroundWindow(SpreadSheetHwnd); Sleep(100); end; if WindowFromPoint(pt) = SpreadSheetHwnd then begin // キャプチャ bmp := TBitmap.Create; try bmp.PixelFormat:= TPixelFormat.pf24bit; // 重要 CaptureToBmp(shtCaptLeft, shtCaptTop, Trunc(shtColWidth*16)+1, Trunc(shtRowHeight * 11)+1, bmp); Image1.Picture.Assign(bmp); finally bmp.Free; end; // ON/OFF をセルの色でチェック for i := 0 to 9 do begin y:= Trunc(shtRowHeight * (i+1) + pickYOff * shtYScale); Pnt := Image1.Picture.Bitmap.ScanLine[y]; for j := 0 to 15 do begin x := Trunc(shtColWidth * j + pickXOff * shtXScale); R := Pnt[x * 3 + 2]; G := Pnt[x * 3 + 1]; B := Pnt[x * 3]; // Blue は ON BitAryNew[i * 16 + 15 - j] := (R = 0) and (G = 0) and (B = $FF); end; end; if not passFlag then begin // 結果表示 n := StrToIntDef('$'+ Copy(Edit1.Text, 2), 0); for i:= 0 to 159 do begin if BitAryNew[i] <> BitAryOld[i] then begin Edit2.Text := Copy(Edit1.Text, 1, 1) + IntToHex(n + (i div 16) * 16 + i mod 16, 3); if BitAryNew[i] then Edit3.Text := 'ON' else Edit3.Text := 'OFF'; end; end; end else begin Edit2.Text := ''; Edit3.Text := ''; for i := 0 to 159 do BitAryNew[i] := False; end; BitAryOld := BitAryNew; end; end; end; procedure TForm4.Button4Click(Sender: TObject); // デバイス ON/OFF 反転 var h, k, n, m : integer; x, y : integer; pt, pt0 : TPoint; begin GetCursorPos(pt0); // 先頭デバイス h := StrToIntDef('$' + Copy(Edit1.Text, 2), 0); // 反転対象のデバイス k := StrToIntDef('$' + Copy(Edit4.Text, 2), -1); if k >= 0 then begin k := k - h; n := k div 16; m := k mod 16; x := shtCaptLeft + Trunc((15 - m) * shtColWidth + pickXOff * shtXScale); y := shtCaptTop + Trunc((n + 1) * shtRowHeight + pickYOff * shtYScale); SetCursorPos(x, y); pt.X := x; pt.Y := y; // マウス直下の Window を取得 if WindowFromPoint(pt) = SpreadSheetHwnd then begin // マウスクリックで Active に mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0); mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0); // [Shift] + [Enter] キーで反転 keybd_event(VK_SHIFT, 0, 0, 0); keybd_event(VK_RETURN, 0, 0, 0); keybd_event(VK_RETURN, 0, KEYEVENTF_KEYUP, 0); keybd_event(VK_SHIFT, 0, KEYEVENTF_KEYUP, 0); end; end; // マウス位置を戻す SetCursorPos(pt0.X, pt0.Y); end; procedure TForm4.FormCreate(Sender: TObject); begin shtXScale := 1.0; shtYScale := 1.0; // デバイス SpreadSheet のセルをアクティブにする左上からオフセット // ピクセルの色取得の位置 pickXOff := 10; pickYOff := 8; end; procedure TForm4.SpeedButton10Click(Sender: TObject); // デバイス変更 begin Edit5.Text := 'Y' + Copy(Edit5.Text, 2); end; procedure TForm4.SpeedButton1Click(Sender: TObject); // [+10],[+1] var n, m : integer; begin n := StrToIntDef('$' + Copy(Edit1.Text, 2), 0); m := StrToIntDef('$' + Copy(Edit4.Text, 2), 0); if Sender as TSpeedButton = SpeedButton1 then Inc(m) else m := m + $10; if m - n < 160 then Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToHex(m, 1); end; procedure TForm4.SpeedButton2Click(Sender: TObject); // [-10],[-1] var n, m : integer; begin n := StrToIntDef('$' + Copy(Edit1.Text, 2), 0); m := StrToIntDef('$' + Copy(Edit4.Text, 2), 0); if Sender as TSpeedButton = SpeedButton2 then Dec(m) else m := m - $10; if m - n >= 0 then Edit4.Text := Copy(Edit4.Text, 1, 1) + IntToHex(m, 1); end; procedure TForm4.SpeedButton5Click(Sender: TObject); // 先頭アドレス変更 [+80],[+100] var m : integer; begin m := StrToIntDef('$' + Copy(Edit5.Text, 2), 0); if Sender as TSpeedButton = SpeedButton5 then m := m+ $80 else m := m + $100; Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToHex(m, 1); end; procedure TForm4.SpeedButton7Click(Sender: TObject); // 先頭アドレス変更 [-80],[-100] var m : integer; begin m := StrToIntDef('$' + Copy(Edit5.Text, 2), 0); if Sender as TSpeedButton = SpeedButton7 then m := m - $80 else m := m - $100; if m >= 0 then Edit5.Text := Copy(Edit5.Text, 1, 1) + IntToHex(m, 1); end; procedure TForm4.SpeedButton9Click(Sender: TObject); // デバイス変更 begin Edit5.Text := 'X' + Copy(Edit5.Text, 2); end; procedure TForm4.Timer1Timer(Sender: TObject); begin Button3Click(self); end; end.