Input Demonstration

Introduction

This program uses the simple circuit described previously. Procedure ApplicationProperties1Idle continuously checks the on-off status of GPIO18. You need to add the TApplicationProperties component (in the "Additional" tab of Lazarus) to the form.

The code of the input unit and form follows a screenshot of the program in action.

Code of u_input_demo.pas

unit u_input_demo;

{Demo input application for GPIO on Raspberry Pi
based on http://wiki.freepascal.org/Lazarus_on_Raspberry_Pi, which was
inspired by the Python input/output demo application by Gareth Halfacree
written for the Raspberry Pi User Guide, ISBN 978-1-118-46446-5}

//Build with Ctrl+F9 then run with SuperUser permissions e.g. sudo ./gpio_input

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  BaseUnix, Unix;

type
  TfrmInputDemo = class(TForm)
    ApplicationProperties1: TApplicationProperties;
    GPIO18CheckBox: TCheckBox;
    LogMemo: TMemo;
    procedure ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
  end;

var
  frmInputDemo: TfrmInputDemo;
  gReturnCode: longint; //stores the result of the IO operation
  buttonStatus: string[1] = '1';  //on
  oldButtonStatus: string[1] = '1';

implementation

{$R *.lfm}

procedure TfrmInputDemo.ApplicationProperties1Idle(Sender: TObject; var Done: Boolean);
var
  fileDesc: integer;
begin
  try
    //Open GPIO18 (P1-12) in read-only mode.
    fileDesc := fpopen('/sys/class/gpio/gpio18/value', O_RdOnly);
    if fileDesc > 0 then
      begin
        //Read status of this pin (1: button pressed, 0: button released).
        gReturnCode := fpread(fileDesc, buttonStatus[1], 1);
        if gReturnCode = 1 then   //if number of bytes read = 1
          begin
            if buttonStatus <> oldButtonStatus then
              begin
                oldButtonStatus := buttonStatus;
                GPIO18CheckBox.Checked := not GPIO18CheckBox.Checked;
                if buttonStatus = '0' then
                  LogMemo.Lines.Add('Off')
                else
                  LogMemo.Lines.Add('On');
                LogMemo.SelStart := Length(LogMemo.Lines.Text) - 1;
              end;
          end
        else
          LogMemo.Lines.Add('Error opening file');
      end;
  finally
    //Close GPIO18 (P1-12).
    gReturnCode := fpclose(fileDesc);
    if gReturnCode <> 0 then
      begin
        LogMemo.Lines.Add('Error when closing file');
        LogMemo.SelStart := Length(LogMemo.Lines.Text) - 1;
      end;
  end;
end;

procedure TfrmInputDemo.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  //Free GPIO18.
  gReturnCode := fpsystem('echo "18" > /sys/class/gpio/unexport');
end;

procedure TfrmInputDemo.FormCreate(Sender: TObject);
begin
  //Prepare GPIO18 (P1-12) for access.
  gReturnCode := fpsystem('echo "18" > /sys/class/gpio/export');
  if gReturnCode = 0 then
    LogMemo.Lines.Add('GPIO18 prepared for access')
  else
    LogMemo.Lines.Add('Error preparing GPIO18 for access');

  //Set GPIO18 as input.
  gReturnCode := fpsystem('echo "in" > /sys/class/gpio/gpio18/direction');
  if gReturnCode = 0 then
     LogMemo.Lines.Add('GPIO18 set as input')
  else
     LogMemo.Lines.Add('Error setting GPIO18 as input');
end;

end.

Code of u_input_demo.lfm

object frmInputDemo: TfrmInputDemo
  Left = 540
  Height = 164
  Top = 166
  Width = 430
  Caption = 'Input Demo'
  ClientHeight = 164
  ClientWidth = 430
  OnClose = FormClose
  OnCreate = FormCreate
  LCLVersion = '0.9.30.4'
  object LogMemo: TMemo
    Left = 8
    Height = 147
    Top = 8
    Width = 268
    Lines.Strings = (
      'LogMemo'
    )
    TabOrder = 0
  end
  object GPIO18CheckBox: TCheckBox
    Left = 280
    Height = 19
    Top = 8
    Width = 138
    Caption = 'GPIO18 Check Box'
    Checked = True
    State = cbChecked
    TabOrder = 1
  end
  object ApplicationProperties1: TApplicationProperties
    OnIdle = ApplicationProperties1Idle
    left = 288
    top = 64
  end
end