ページを更新する

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;

    // 先頭デバイスが変わったときは、１回パス
    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.