Delphi Can

USCO 01 TIVA ARM mikrodenetleyicisi ve HC-06 BlueTooth cihazı ile yapılan örnek bir proje ve kaynak kodları.

BIN ve APK Dosyası     BlueTooth için oldukça güzel bir terminoloji ve bluetooth protokol dökümanları.

Projenin Delphi Kaynak kodları. OrangeUI'dan alıntı bir kalıpla yapıldı.

[attachment=1002]

unit MainFrame;

interface

uses
 System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
 FMX.Types, FMX.Graphics, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.StdCtrls, System.Bluetooth,

 uUIFunction, FMX.ListBox, FMX.ScrollBox, FMX.Memo, uSkinFireMonkeyControl, uSkinButtonType,
 uSkinFireMonkeyButton, FMX.Controls.Presentation, FMX.TabControl, uSkinMaterial;

type
 TFrameMain = class(TFrame)
   Panel2: TPanel;
   Memo1: TMemo;
   KnownDevices: TButton;
   CBDevices: TComboBox;
   TabControl1: TTabControl;
   TabItem1: TTabItem;
   TabItem3: TTabItem;
   SkinFMXButton4: TSkinFMXButton;
   SkinFMXButton5: TSkinFMXButton;
   SkinFMXButton6: TSkinFMXButton;
   SkinFMXButton7: TSkinFMXButton;
   SkinFMXButton8: TSkinFMXButton;
   SkinFMXButton9: TSkinFMXButton;
   SkinFMXButton10: TSkinFMXButton;
   SkinFMXButton11: TSkinFMXButton;
   SkinFMXButton12: TSkinFMXButton;
   btnShowFirstFrame: TButton;
   TrackBar1: TTrackBar;
   TrackBar2: TTrackBar;
   TrackBar3: TTrackBar;
   Switch1: TSwitch;
   Switch2: TSwitch;
   Switch3: TSwitch;
   Label1: TLabel;
   procedure btnShowFirstFrameClick(Sender: TObject);
   procedure DiscoveryEnd(const Sender: TObject; const ADeviceList: TBluetoothDeviceList);
   function FindBTDevice(Device: string): TBluetoothDevice;
   procedure KnownDevicesClick(Sender: TObject);
   procedure SkinFMXButton4Click(Sender: TObject);
   procedure DO_GONDER(KOMUT, BILESEN: String);
   procedure Memo1DblClick(Sender: TObject);
   procedure Switch1Switch(Sender: TObject);
   procedure Switch2Switch(Sender: TObject);
   procedure Switch3Switch(Sender: TObject);
   procedure CIHAZ_KONTROL;

 private
   { Private declarations }
 public
   FrameHistroy: TFrameHistroy;
   cad: String;
   Buff: TBytes;
   LDevice: TBluetoothDevice;
   LSockect: TBluetoothSocket;
   SAY: Integer;

   procedure DoReturnFromFirstFrame(AFromFrame: TFrame);
   { Public declarations }

   constructor Create(AOwner: TComponent); override;

 end;

var
 // 声明全局的Frame
 GlobalMainFrame: TFrameMain;
 Manager: TBluetoothManager;
 Adapter: TBluetoothAdapter;
 PairedDevices: TBluetoothDeviceList;
 DiscoveredDevices: TBluetoothDeviceList;
 TestServiceClass_UUID: TGUID;

implementation

uses
 MainForm,
 FirstFrame, DataForm;

{$R *.fmx}

procedure TFrameMain.CIHAZ_KONTROL;
begin

 if CBDevices.ItemIndex < 0 then
 begin
   ShowMessage('Lütfen Cihaz Seçiniz');
   Exit;
 end;
 Memo1.Lines.Clear;

end;

procedure TFrameMain.DO_GONDER(KOMUT, BILESEN: String);
var
 Temp: TComponent;
begin
 Buff := TEncoding.UTF8.GetBytes(KOMUT);
 LDevice := FindBTDevice(CBDevices.Selected.Text);
 if (LDevice <> nil) then
 begin
   LSockect := LDevice.CreateClientSocket(TestServiceClass_UUID, True);
   try
     LSockect.Connect;
     if not LSockect.Connected then
     begin
       ShowMessage('Cihaz''a Balanamadı.');
       Exit;
     end;
     Memo1.Lines.Add('BlueTooth Bağlandı');
     Application.ProcessMessages;
     LSockect.SendData(Buff);
     Memo1.Lines.Add('Gönderilen Komut: ' + KOMUT);
     Application.ProcessMessages;
     LSockect.Close;
     Memo1.Lines.Add('BlueTooth Kapandı');
     Application.ProcessMessages;
     Memo1.Lines.Add(DateTimeToStr(Now));
     Application.ProcessMessages;
   except
     Memo1.Lines.Add('HATA. Komut çalışmadı');
     Temp := FindComponent(BILESEN);
     if Temp is TSkinFMXButton then
       (Temp as TSkinFMXButton).Prop.Icon.ImageIndex := 0;
   end;
   LSockect.Free;
 end;
 Timer1.Enabled := False;

end;

constructor TFrameMain.Create(AOwner: TComponent);
begin
 inherited;
 Manager := TBluetoothManager.Current;
 Manager.OnDiscoveryEnd := DiscoveryEnd;
 TestServiceClass_UUID := StringToGUID('{00001101-0000-1000-8000-00805F9B34FB}'); // SPP
 SAY := 0;

 Switch1.Position.Y := TrackBar1.Position.Y;
 Switch2.Position.Y := TrackBar2.Position.Y;
 Switch3.Position.Y := TrackBar3.Position.Y;

end;

procedure TFrameMain.DiscoveryEnd(const Sender: TObject; const ADeviceList: TBluetoothDeviceList);
var
 I: Integer;
 LDevice: TBluetoothCustomDevice;
begin
 DiscoveredDevices := ADeviceList;
 Memo1.Lines.Add('Devices discovered: ');
 for I := 0 to ADeviceList.Count - 1 do
 begin
   LDevice := ADeviceList.Items[I];
   Memo1.Lines.Add(LDevice.Address + ': ' + LDevice.DeviceName);
 end;
end;

function TFrameMain.FindBTDevice(Device: string): TBluetoothDevice;
var
 I: integer;
 LDevice: TBluetoothDevice;
 KnownDevices: TBluetoothDeviceList;
begin
 KnownDevices := Manager.GetPairedDevices(Manager.CurrentAdapter);
 for I := 0 to KnownDevices.Count - 1 do
 begin
   LDevice := KnownDevices.Items[I];
   if Device = LDevice.DeviceName then
     Exit(LDevice);
 end;

 KnownDevices := Manager.LastDiscoveredDevices;
 for I := 0 to KnownDevices.Count - 1 do
 begin
   LDevice := KnownDevices.Items[I];
   if Device = LDevice.DeviceName then
     Exit(LDevice);
 end;

 Result := nil;
end;

procedure TFrameMain.KnownDevicesClick(Sender: TObject);
var
 I: integer;
begin
 PairedDevices := Manager.CurrentAdapter.PairedDevices;
 CBDevices.Items.Clear;

 for I := 0 to PairedDevices.Count - 1 do
   CBDevices.Items.Add(PairedDevices.Items[I].DeviceName);
 CBDevices.ItemIndex := 0;

end;

procedure TFrameMain.Memo1DblClick(Sender: TObject);
begin
 Memo1.Lines.Clear;
end;

procedure TFrameMain.btnShowFirstFrameClick(Sender: TObject);
begin
 HideFrame(Self, hfcttBeforeShowFrame);
 ShowFrame(TFrame(GlobalFirstFrame), TFrameFirst, frmMain, nil, nil, DoReturnFromFirstFrame, Application);
 GlobalFirstFrame.FrameHistroy := CurrentFrameHistroy;
 GlobalFirstFrame.LoadData('Data');
end;

procedure TFrameMain.DoReturnFromFirstFrame(AFromFrame: TFrame);
begin
 if AFromFrame <> nil then
 begin
   if AFromFrame is TFrameFirst then
   begin
     FMX.Types.Log.d('OrangeUI Return From FirstFrame!');
     Self.Memo1.Lines.Add('您输入了 ' + TFrameFirst(AFromFrame).Edit1.Text);
   end;
 end
 else
 begin
   FMX.Types.Log.d('OrangeUI Return From nil!');
 end;
end;

procedure TFrameMain.SkinFMXButton4Click(Sender: TObject);
begin

 TRY
   CIHAZ_KONTROL;

   if (Sender as TSkinFMXButton).Prop.Icon.ImageIndex = 0 then
   begin
     (Sender as TSkinFMXButton).Prop.Icon.ImageIndex := 1; // 'do 00 1 '
     DO_GONDER('do ' + (Sender as TSkinFMXButton).Prop.Icon.Url + ' 1 ', (Sender as TSkinFMXButton).Name);
   end
   else
   begin
     (Sender as TSkinFMXButton).Prop.Icon.ImageIndex := 0;
     DO_GONDER('do ' + (Sender as TSkinFMXButton).Prop.Icon.Url + ' 0 ', (Sender as TSkinFMXButton).Name);
   end;

 EXCEPT
   (Sender as TSkinFMXButton).Prop.Icon.ImageIndex := 0;
   Application.ProcessMessages;
   ShowMessage('Cihaz Hatası');
 END;

end;

procedure TFrameMain.Switch1Switch(Sender: TObject);
begin

 CIHAZ_KONTROL;

 if Switch1.IsChecked then
   DO_GONDER('pwm 00 ' + FloatToStr(TrackBar1.Value) + ' 1 ', 'Switch1')
 else
   DO_GONDER('pwm 00 ' + FloatToStr(TrackBar1.Value) + ' 0 ', 'Switch1');

end;

procedure TFrameMain.Switch2Switch(Sender: TObject);
begin

 CIHAZ_KONTROL;

 if Switch2.IsChecked then
   DO_GONDER('pwm 01 ' + FloatToStr(TrackBar2.Value) + ' 1 ', 'Switch2')
 else
   DO_GONDER('pwm 01 ' + FloatToStr(TrackBar2.Value) + ' 0 ', 'Switch2');

end;

procedure TFrameMain.Switch3Switch(Sender: TObject);
begin

 CIHAZ_KONTROL;

 if Switch3.IsChecked then
   DO_GONDER('pwm 02 ' + FloatToStr(TrackBar3.Value) + ' 1 ', 'Switch3')
 else
   DO_GONDER('pwm 02 ' + FloatToStr(TrackBar3.Value) + ' 0 ', 'Switch3');

end;

end.

Elinize sağlık hocam.