728x90

출처

MMDevApi.pas

unit MMDevApi;

interface

uses
  Windows, ActiveX, ComObj;

const
  CLSID_MMDeviceEnumerator : TGUID = '{BCDE0395-E52F-467C-8E3D-C4579291692E}';
  IID_IMMDeviceEnumerator : TGUID = '{A95664D2-9614-4F35-A746-DE8DB63617E6}';
  IID_IMMDevice : TGUID = '{D666063F-1587-4E43-81F1-B948E807363F}';
  IID_IMMDeviceCollection : TGUID = '{0BD7A1BE-7A1A-44DB-8397-CC5392387B5E}';
  IID_IAudioEndpointVolume : TGUID = '{5CDF2C82-841E-4546-9722-0CF74078229A}';
  IID_IAudioMeterInformation : TGUID = '{C02216F6-8C67-4B5B-9D00-D008E73E0064}';
  IID_IAudioEndpointVolumeCallback : TGUID = '{657804FA-D6AD-4496-8A60-352752AF4F89}';
  IID_IMMNotificationClient : TGUID = '{7991EEC9-7E89-4D85-8390-6C703CEC60C0}';

  DEVICE_STATE_ACTIVE = $00000001;
  DEVICE_STATE_UNPLUGGED = $00000002;
  DEVICE_STATE_NOTPRESENT = $00000004;
  DEVICE_STATEMASK_ALL = $00000007;

type
 PAUDIO_VOLUME_NOTIFICATION_DATA = ^AUDIO_VOLUME_NOTIFICATION_DATA;
 AUDIO_VOLUME_NOTIFICATION_DATA = packed record
  guidEventContext: TGUID;
  bMuted: BOOL;
  fMasterVolume: Single;
  nChannels: UINT;
  afChannelVolumes: array[1..1] of Single;
 end;

type
  EDataFlow = TOleEnum;

const
  eRender = $00000000;
  eCapture = $00000001;
  eAll = $00000002;
  EDataFlow_enum_count = $00000003;

type
  ERole = TOleEnum;

const
  eConsole = $00000000;
  eMultimedia = $00000001;
  eCommunications = $00000002;
  ERole_enum_count = $00000003;

type
  IAudioEndpointVolumeCallback = interface(IUnknown)
  [IID_IAudioEndpointVolumeCallback]
    function OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HRESULT; stdcall;
  end;

  IAudioEndpointVolume = interface(IUnknown)
  [IID_IAudioEndpointVolume]
    function RegisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): Integer; stdcall;
    function UnregisterControlChangeNotify(AudioEndPtVol: IAudioEndpointVolumeCallback): Integer; stdcall;
    function GetChannelCount(out PInteger): Integer; stdcall;
    function SetMasterVolumeLevel(fLevelDB: single; pguidEventContext: PGUID): Integer; stdcall;
    function SetMasterVolumeLevelScalar(fLevelDB: single; pguidEventContext: PGUID): Integer; stdcall;
    function GetMasterVolumeLevel(out fLevelDB: single): Integer; stdcall;
    function GetMasterVolumeLevelScaler(out fLevelDB: single): Integer; stdcall;
    function SetChannelVolumeLevel(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): Integer; stdcall;
    function SetChannelVolumeLevelScalar(nChannel: Integer; fLevelDB: double; pguidEventContext: PGUID): Integer; stdcall;
    function GetChannelVolumeLevel(nChannel: Integer; out fLevelDB: double): Integer; stdcall;
    function GetChannelVolumeLevelScalar(nChannel: Integer; out fLevel: double): Integer; stdcall;
    function SetMute(bMute: Boolean; pguidEventContext: PGUID): Integer; stdcall;
    function GetMute(out bMute: Boolean): Integer; stdcall;
    function GetVolumeStepInfo(pnStep: Integer; out pnStepCount: Integer): Integer; stdcall;
    function VolumeStepUp(pguidEventContext: PGUID): Integer; stdcall;
    function VolumeStepDown(pguidEventContext: PGUID): Integer; stdcall;
    function QueryHardwareSupport(out pdwHardwareSupportMask): Integer; stdcall;
    function GetVolumeRange(out pflVolumeMindB: double; out pflVolumeMaxdB: double; out pflVolumeIncrementdB: double): Integer; stdcall;
  end;

  IAudioMeterInformation = interface(IUnknown)
  [IID_IAudioMeterInformation]
    function GetPeakValue(out Peak: Real): HRESULT; stdcall;
  end;

  IPropertyStore = interface(IUnknown)
  end;

  IMMDevice = interface(IUnknown)
  [IID_IMMDevice]
    function Activate(const refId: TGUID; dwClsCtx: DWORD; pActivationParams: PInteger; out pEndpointVolume: IAudioEndpointVolume): HRESULT; stdCall;
    function OpenPropertyStore(stgmAccess: DWORD; out ppProperties: IPropertyStore): HRESULT; stdcall;
    function GetId(out ppstrId: PLPWSTR): HRESULT; stdcall;
    function GetState(out State: Integer): HRESULT; stdcall;
  end;

  IMMDeviceCollection = interface(IUnknown)
  [IID_IMMDeviceCollection]
    function GetCount(out pcDevices: UINT): HRESULT; stdcall;
    function Item(nDevice: UINT; out ppDevice: IMMDevice): HRESULT; stdcall;
  end;

  IMMNotificationClient = interface(IUnknown)
  [IID_IMMNotificationClient]
  end;

  IMMDeviceEnumerator = interface(IUnknown)
  [IID_IMMDeviceEnumerator]
    function EnumAudioEndpoints(dataFlow: EDataFlow; deviceState: SYSUINT; out DevCollection: IMMDeviceCollection): HRESULT; stdcall;
    function GetDefaultAudioEndpoint(EDF: SYSUINT; ER: SYSUINT; out Dev: IMMDevice): HRESULT; stdcall;
    function GetDevice(pwstrId: pointer; out Dev: IMMDevice): HRESULT; stdcall;
    function RegisterEndpointNotificationCallback(pClient: IMMNotificationClient): HRESULT; stdcall;
    function UnregisterEndpointNotificationCallback(pClient: IMMNotificationClient): HRESULT; stdcall;
  end;

implementation

end.

Demo

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  MMDevApi, ActiveX, ComObj, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TEndpointVolumeCallback = class(TInterfacedObject, IAudioEndpointVolumeCallback)
    function OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HRESULT; stdcall;
  end;

  TForm1 = class(TForm)
    trackVolumeLevel: TTrackBar;
    spdMute: TCheckBox;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    endpointVolume: IAudioEndpointVolume;
  public
    { Public declarations }
    procedure doMasterVolumeMute(bMute: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.doMasterVolumeMute(bMute: Boolean);
var
  MMDeviceCollection: IMMDeviceCollection;
  MMDeviceEnumerator: IMMDeviceEnumerator;
  device :IMMDevice ;
  hr: HRESULT;
  deviceCount : UINT;
  i : integer;
begin
  hr := CoCreateInstance(CLSID_MMDeviceEnumerator, nil, CLSCTX_ALL, IID_IMMDeviceEnumerator, MMDeviceEnumerator);
  if hr <> ERROR_SUCCESS then ShowMessage(SysErrorMessage(hr));

  MMDeviceCollection := nil; // wegen dem OUT-Parameter *1
  hr := MMDeviceEnumerator.EnumAudioEndpoints(eRender, DEVICE_STATE_ACTIVE, MMDeviceCollection);
  if hr <> ERROR_SUCCESS then ShowMessage(SysErrorMessage(hr));

  hr := MMDeviceCollection.GetCount(deviceCount);
  if hr <> ERROR_SUCCESS then ShowMessage(SysErrorMessage(hr));

  for i:=0 to deviceCount-1 do begin
    MMDeviceCollection.Item(i, device);
    endpointVolume:=nil;
    device.Activate(IID_IAudioEndpointVolume, CLSCTX_INPROC_SERVER, nil, endpointVolume);
    endpointVolume.SetMute(bMute,nil);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  doMasterVolumeMute(true);
end;

end.
728x90
728x90

출처 : Lazarus on Raspberry Pi
RaspberyPi rpi_hal Hardware Abstraction Library

라이브러리 다운로드

rudiratlos/rpi-hal 다운로드

rpi_hal 버그가 있어서 제가 수정했습니다. 압축된 소스 파일에 수정된 rpi_hal.pas 파일을 첨부했습니다.

빌드옵션

빌드 옵션으로 UseCThreads 추가가 필요합니다.

소스

RaspberryPI LED.7z

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  rpi_hal;

type

  { TForm1 }

  TForm1 = class(TForm)
    ToggleBox1: TToggleBox;
    ToggleBox2: TToggleBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ToggleBox1Change(Sender: TObject);
    procedure ToggleBox2Change(Sender: TObject);
  private
    { private declarations }
    isr_1 : isr_t;
    isr_2 : isr_t;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  GPIO20 = 20;
  GPIO21 = 21;

function my_isr(gpio_nr:integer):integer;
// for gpio_int testing. will be called on interrupt
const waittim_ms=1;
begin
  writeln ('my_isr fired for GPIO',gpio_nr,' servicetime: ',waittim_ms:0,'ms');
  sleep(waittim_ms);
  my_isr:=999;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  writeln('Show CPU-Info, RPI-HW-Info and Registers:');
  rpi_show_all_info;

  isr_1.gpio := GPIO20;
  isr_1.rising_edge := true;
  gpio_set_int(isr_1, GPIO20, @my_isr, true, OUTPUT);
  gpio_int_enable(isr_1);

  isr_2.gpio := GPIO21;
  isr_2.rising_edge := true;
  gpio_set_int(isr_2, GPIO21, @my_isr, true, OUTPUT);
  gpio_int_enable(isr_2);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  gpio_int_disable(isr_1);
  gpio_int_release(isr_1);

  gpio_int_disable(isr_2);
  gpio_int_release(isr_2);
end;

procedure TForm1.ToggleBox1Change(Sender: TObject);
begin
  gpio_set_pin(isr_1.gpio, ToggleBox1.Checked);
end;

procedure TForm1.ToggleBox2Change(Sender: TObject);
begin
  gpio_set_pin(isr_2.gpio, ToggleBox2.Checked);
end;

end.

실행

$ chmod 755 raspi_led
$ sudo ./raspi_led


728x90
728x90

출처 : CT on MacOS X 10.11.x (El Capitan)
PilotLogic - MacOS - Detail Installation
PilotLogic - Setup Script Options

0. CodeTyphon 삭제 ( 기본에 설치되어 있는 경우)

$ cd /usr/local
$ sudo rm -Rf codetyphon

1. xcode 설치

2. xcode command tool 설치

$ xcode-select --install

3. XQuartz 설치

XQuartz 2.7.8 (For OS X 10.6.3 or later (including El Capitan) 다운로드

XQuartz 미설치 오류

4. MacPorts 설치

MacPorts OS X 10.11 El Capitan 다운로드

5. 사용자 sudo 권한 부여

$ sudo vi /etc/sudoers

내용추가 - bluesanta 사용자의 root권한 부여

bluesanta       ALL=(ALL) NOPASSWD: ALL

6. CodeTyphon 다운로드 및 설치

다운로드

설치 스크립트(install.sh) 실행

$ cd Downloads/CodeTyphonIns
$ ./install.sh
  
====================================================
             CodeTyphon Studio 
            Version 5.60 (GEN V)
   Installation for: Linux-Solaris-FreeBSD-MacOS
====================================================
 
WARNING: Improper use of the sudo command could lead to data loss
or the deletion of important system files. Please double-check your
typing when using sudo. Type "man sudo" for more information.
 
To proceed, enter your password, or type Ctrl-C to abort.
 
Password:

CodeTyphon 설치

 
   0) Install CodeTyphon Studio
  
   9) Exit
  
>>> Select an action (press 0..9 key): 0

설치 스크립트 종료

====================================================
  CodeTyphon Studio 5.60 Setup for Darwin64
   Settings: Platform=carbon  Multiarch Mode=1
====================================================
   
   0) Install System Libraries
   1) Run CodeTyphon Center (CTC)
   
     11) -- Platform (widget) Setup
     12) -- Multi-Architecture Setup
   
   3) Remove FreePascal
   4) Remove and Build FreePascal
   
   5) Remove Typhon IDE
   6) Remove and Build Typhon IDE
   
   7) Remove ALL
   8) Remove and Build ALL
   
   9) EXIT
   
>>>  Select an action (press 0..9 key): 9

7. Install System Libraries


8. 모두(FPC, Typhon, COcean) 빌드 하기


// shryu

{$IFDEF FPC}

  type HWND = type THandle;

{$ENDIF}







728x90
728x90

출처 : 델마당 - 라즈베리 파이(Raspberry Pi) 보드 크로스 컴파일 환경 구축 성공(Win7 => 라즈베리)
Cross-Build for RasberryPi
TOPIC: How to build app for Raspberry Pi from Windows 7
Setup Cross Compile For ARM

Lazarus

Lazarus라는 RAD툴 입니다.
아직 설치 방법은 작성중이고, 우선 개발된 소스와 실행 파일을 올립니다.
기본언어는 Pascal 이고, 상용툴로 Delphi와 비슷합니다.
Raspberry PI용 화면개발을 하실 일이 있다면 편하게 작성하실수 있습니다.

설치방법과 GPIO관련 내용은 따로 작성해서 올리겠습니다.

GPIO 컴포넌트

rpi-hal 링크

CodeTyphon 다운로드

Cross-Build for RasberryPi 다운로드

설치

CodeTyphonIns\install.bat 관리자로 실행

Lazarus 실행

화면디자인

소스코드 Unit1.pas project1.zip

unit Unit1;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  //
  Edit1.Text := 'Hello Raspberry !!!';
end;

end.

Windows에서 실행

 

Raspberry PI 용 컴파일 옵션 설정

Raspberry PI에서 실행

 

728x90
728x90

출처 : Delphi - Http POST call
TStream.ReadBuffer Method
TEncoding.GetString Method (TBytes)

procedure TForm1.Button2Click(Sender: TObject);
var
  tmpBuffer, Buffer: TBytes;
  LFileStream: TFileStream;
  test : String;
begin
  //
  LFileStream := TFileStream.Create(Path + 'test.smi', fmOpenRead);

  try
    Memo1.Lines.BeginUpdate;

    // Read file into buffer
    SetLength(Buffer, LFileStream.Size);
    LFileStream.ReadBuffer(Buffer[0], Length(Buffer));

    SetLength(tmpBuffer, Length(Buffer)-2);
    CopyMemory(tmpBuffer, @Buffer[2], Length(Buffer)-2  );

    test := TEncoding.Unicode.GetString(Buffer);
    Memo1.Lines.Add(test);
  finally
    Memo1.Lines.EndUpdate;
    LFileStream.Free;
  end;
end;


728x90
728x90

Delphi - Http POST call

DelphiHttpPostCall.7z

procedure TForm1.Button1Click(Sender: TObject);
var
  sl : TStringList;
  ResponseStream: TMemoryStream;
  resultBytes: TBytes;
begin
  sl := TStringList.Create;
  ResponseStream := TStringStream.Create;
  try
    IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded';
    sl.Add('id=' + Edit2.Text);
    IdHTTP1.Post(Edit1.Text, sl, ResponseStream);
    ResponseStream.Position := 0;

    SetLength(resultBytes, ResponseStream.Size);
    ResponseStream.ReadBuffer(resultBytes[0], Length(resultBytes));

    Memo1.Lines.Text := TEncoding.UTF8.GetString(resultBytes);
  finally
    sl.Free;
    ResponseStream.Free;
  end;
end;
728x90
728x90

Delphi - Byte 관련 Tip

function BytesToHex(aSource: TBytes): string;
begin
  SetLength(Result, Length(aSource) * 2);
  if Length(aSource) > 0 then
    BinToHex(aSource[0], PChar(Result), Length(aSource));
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  SetupLdrExeHeaderOffset = $01d204;
  A: Array[0..3] of Byte = ($EF, $BE, $AD, $DE);
var
  HInstance: THandle;
  filename: String;
  FileStream: TFileStream;
  ArrayBytesHeader, ArrayBytesHeaderStr : TBytes;
  HeaderStr : String;
begin
  // AbZipper1.FileName := 'C:\AAPlus4PC_server\ALZip861.exe';
  filename := 'C:\AAPlus4PC_server\ALZip861.exe';

  FileStream := TFileStream.Create(filename, fmOpenRead);
  try

    FileStream.Seek( SetupLdrExeHeaderOffset , soBeginning);

    SetLength( ArrayBytesHeader, 16 );
    FileStream.ReadBuffer(ArrayBytesHeader, 16);

    if (CompareMem(ArrayBytesHeader, @A, 4)) then begin
      SetLength(ArrayBytesHeaderStr, 12);
      CopyMemory( ArrayBytesHeaderStr, @ArrayBytesHeader[4], 12  );

      HeaderStr := TEncoding.ASCII.GetString(ArrayBytesHeaderStr);
      //Memo1.Lines.Add( BytesToHex(ArrayBytesHeader) );
      //Memo1.Lines.Add( BytesToHex(ArrayBytesHeaderStr) + '/' + HeaderStr );

      if HeaderStr='NullsoftInst' then begin
        Memo1.Lines.Add( 'ooooo' );
      end else begin
        Memo1.Lines.Add( 'xxxxx - 2' );
      end;

    end else begin
      Memo1.Lines.Add( 'xxxxx - 1' );
    end;
  finally
    SetLength(ArrayBytesHeader, 0);
    SetLength(ArrayBytesHeaderStr, 0);
    FileStream.Free;
  end;
end;
728x90
728x90

D7 for Delphi 7
D9 for Delphi 2005
D10 for Delphi 2006
D11 for Delphi 2007
D12 for Delphi 2009
D14 for Delphi 2010
D15 for Delphi XE
D16 for Delphi XE2
D17 for Delphi XE3

728x90

+ Recent posts