unit PIC_ICP;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DevicesFrame, ImgList, ComCtrls, StdCtrls, Mask, ToolEdit, ComboDigEdit,
  ToolWin, ExtCtrls, RUtilites, HexGrid, SendThread, CommInt, Math, CreateMenu;

type
  TDataBuf = array[0..127] of byte;



  TfrmMICROCHIP_PIC_ICP = class(TfrmDevice)
    procedure tbReadClick(Sender: TObject);
    procedure tbEraseClick(Sender: TObject);
    procedure tbWriteClick(Sender: TObject);
    procedure tbVerifyClick(Sender: TObject);
  private
    FPinTX:boolean;
    Const10us:longint;
    F_endprog_req:boolean;
    function  Get_Pin_Data:Integer;
    procedure Set_Pin_Data(b:integer);
    function  Get_Pin_Clock:Integer;
    procedure Set_Pin_Clock(b:integer);
    function  Get_Pin_MCLR:Integer;
    procedure Set_Pin_MCLR(b:integer);
    function  CollectNodesData(strID:string):word;
  protected
    procedure SendCmdToChip(cmd:integer);
    function  ReadDataFromChip:integer;
    procedure SendDataToChip(dt:word);

    //Процедуры передаваемые на выполнение потоку SendThread

    procedure Tr_ResetChip;
    procedure Tr_ReadChipMemoryToGrid(ArIndx:integer;Grid:THexGrid;cmd:integer);
    procedure Tr_ReadChipMemoryToBuf(ArIndx:integer;var Buf:TDataBuf;cmd:integer);
    Procedure Tr_ProgramChipFromGrid(ArIndx:integer;Grid:THexGrid;cmd:integer);
    procedure Tr_ReadProcess;
    procedure Tr_WriteProcess;
    procedure Tr_EraseProcess;

  public
    class procedure CreateInPlace(Owner:TWinControl;ChipName:String;var aCommPort:TComm);override;
    constructor Create(AOwner: TComponent); override;
    property Pin_Data:  integer read Get_Pin_Data write Set_Pin_Data;
    property Pin_Clock: integer read Get_Pin_Clock write Set_Pin_Clock;
    property Pin_MCLR:  integer read Get_Pin_MCLR write Set_Pin_MCLR;

  end;

var

  frmMICROCHIP_PIC_ICP: TfrmMICROCHIP_PIC_ICP;

implementation

uses MainForm, InProgress, ErrorRep;

{$R *.DFM}
class procedure TfrmMICROCHIP_PIC_ICP.CreateInPlace(Owner:TWinControl;ChipName:String;var aCommPort:TComm);
var frm:TfrmMICROCHIP_PIC_ICP;
    SectName:string;
begin
  frm:=Create(Owner);
  SectName:='Chip '+ChipName;
  if Pos('PIC16F7', ChipName)<>0 then  frm.F_endprog_req:=true;
  frm.lblDeviceName.Caption:=MemIniFile.ReadString(sectName,'ItemCaption','');
  frm.Parent:=Owner;
  frm.Align:=alClient;
  frm.Visible:=true;
  frm.CommPort:=aCommPort;
  //  Заполнение области Areas

  frm.FillAreaAndParams(SectName);
  if not frm.CommPort.Enabled then frm.CommPort.Open;
  frm.Pin_MCLR:=0;
  frm.Pin_Data:=0;
  frm.Pin_Clock:=0;
  frm.Const10us:=Round(10/CalibrConst);

end;


constructor TfrmMICROCHIP_PIC_ICP.Create(AOwner: TComponent);
begin
  inherited;
  InitRequired:=false;
  frmMain.LoFirstOrder:=true;
end;



function TfrmMICROCHIP_PIC_ICP.Get_Pin_Data:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_Data:= bi[CommPort.CTS];
end;

procedure TfrmMICROCHIP_PIC_ICP.Set_Pin_Data(b:integer);
const ib:array[0..1] of boolean = (false, true);
begin
  CommPort.SetDTRState(not ib[b]);
end;


function TfrmMICROCHIP_PIC_ICP.Get_Pin_Clock:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_Clock:= bi[not CommPort.DSR];
end;

procedure TfrmMICROCHIP_PIC_ICP.Set_Pin_Clock(b:integer);
const ib:array[0..1] of boolean = (false, true);
begin
  CommPort.SetRTSState(ib[b]);
end;


function TfrmMICROCHIP_PIC_ICP.Get_Pin_MCLR:integer;
const bi:array [boolean] of integer = (0,1);
begin
  Get_Pin_MCLR:= bi[FPinTX];
end;

procedure TfrmMICROCHIP_PIC_ICP.Set_Pin_MCLR(b:integer);
const ib:array[0..1] of boolean = (false, true);

begin
  CommPort.SetBREAKState(ib[b]);
  FPinTX:=ib[b];
end;


procedure TfrmMICROCHIP_PIC_ICP.tbReadClick(Sender: TObject);
begin
  FVerify:=false;
  self.FProcessProc:=Tr_ReadProcess;
  inherited;
end;

procedure TfrmMICROCHIP_PIC_ICP.tbVerifyClick(Sender: TObject);
begin
  FVerify:=true;
  StrList_ErrorsRep.Clear;
  self.FProcessProc:=Tr_ReadProcess;
  inherited;
  if StrList_ErrorsRep.Count<>0 then
    with TfrmErrorRep.Create(Self) do
    begin
      LstBxErrorRep.Clear;
      LstBxErrorRep.Items.Assign(StrList_ErrorsRep);
      ShowModal;
    end;

end;


procedure TfrmMICROCHIP_PIC_ICP.tbWriteClick(Sender: TObject);
begin
  self.FProcessProc:=Tr_WriteProcess;
  inherited;
end;


procedure TfrmMICROCHIP_PIC_ICP.tbEraseClick(Sender: TObject);
begin
  self.FProcessProc:=Tr_EraseProcess;
  inherited;
end;


{
.................................................................

Процедуры передаваемые на выполнение потоку SendThread

.................................................................
}

procedure  TfrmMICROCHIP_PIC_ICP.Tr_ResetChip;
begin
  Pin_Clock:=0;
  Pin_Data:=0;
  Pin_MCLR:=0;
  sleep(5);
  Pin_MCLR:=1;
  sleep(5);
end;

procedure TfrmMICROCHIP_PIC_ICP.SendCmdToChip(cmd:integer);
var i:integer;
begin
  for i:=0 to 5 do
  begin
    Pin_Clock:=1;
    Pin_Data:=(cmd shr i) and 1;
    DelayUs(Const10us);
    Pin_Clock:=0;
  end;
end;

function TfrmMICROCHIP_PIC_ICP.ReadDataFromChip:integer;
var i:integer;
    bit:integer;
    dt:integer;
begin

  Pin_Data:=1;
  dt:=0;
  for i:=0 to 15 do
  begin
    Pin_Clock:=1;
    DelayUs(Const10us);
    bit:=Pin_Data;
    dt:=dt + (bit shl i);
    Pin_Clock:=0;
  end;
  ReadDataFromChip:=(dt shr 1) and FDataMask;
end;

procedure TfrmMICROCHIP_PIC_ICP.SendDataToChip(dt:word);
var i:integer;
begin
  dt:=(dt shl 1) and $7FFF;
  for i:=0 to 15 do
  begin
    Pin_Clock:=1;
    Pin_Data:=(dt shr i) and 1;
    DelayUs(Const10us);
    Pin_Clock:=0;
  end;
end;


procedure TfrmMICROCHIP_PIC_ICP.Tr_ReadChipMemoryToGrid(ArIndx:integer; // индекс области программирования
                                Grid:THexGrid;                    // текущая сетка данных
                                cmd:integer);                     // команда
var
  firstAddr,lastAddr:Word;
//  InBuf:TThreadBuf;
  indx:Longint;
//  bufStr:string;
  k:Cardinal;
  DataWord:DWORD;
  ActualBitN:Integer;
  wrd:word;
  errcnt:integer;
begin
  with FSendThread do
  begin
    Tr_ResetChip;
    Synchronize(frmInProgress.InitGauge);
    firstAddr:=AreasData[ArIndx].DataArr[0];
    lastAddr:=AreasData[ArIndx].DataArr[1];
    ActualBitN:=AreasData[ArIndx].DataArr[2];
    FDataMask:=GetDataMask(ActualBitN);
    k:= (lastAddr-firstAddr+1);  //  Количество читаемых слов
    errcnt:=0;
    for indx:=1 to k do
    begin
      if  Terminated then abort;
      SendCmdToChip(cmd);
      DataWord:=ReadDataFromChip;
      if  ActualBitN>8 then
      begin
        if FVerify then
        begin
          wrd:=Grid.AData[(indx-1)*2+1] or  (Grid.Adata[(indx-1)*2] shl 8);
          if DataWord<>wrd then
          begin
            if errcnt=10 then StrList_ErrorsRep.Add('More errors ...');
            if errcnt<10 then
            begin
              StrList_ErrorsRep.Add(AreasData[ArIndx].strCapt+'   '+format('Addres: %4.4x  Source: %4.4x <> Chip: %4.4x',[indx-1,wrd,DataWord]));
            end;
            Inc(errcnt);
          end;
        end
        else
        begin
          Grid.AData[(indx-1)*2+1]:=DataWord and $FF;
          Grid.Adata[(indx-1)*2]:= DataWord shr 8;
        end;
      end
      else
      begin
        if FVerify then
        begin
          wrd:=Grid.AData[indx-1];
          if (DataWord and $FF)<>wrd then
          begin
            if errcnt=10 then StrList_ErrorsRep.Add('More errors ...');
            if errcnt<10 then
            begin
              StrList_ErrorsRep.Add(AreasData[ArIndx].strCapt+'   '+format('Addres: %4.4x  Source: %2.2x <> Chip: %2.2x',[indx-1,byte(wrd),byte(DataWord)]));
            end;
            Inc(errcnt);
          end;
        end
        else
        begin
          Grid.AData[indx-1]:=DataWord and $FF;
        end;
      end;
      SendCmdToChip(6); // Команда увеличения адреса
      frmInProgress.ProgrPos:=Round(100*indx/k);
      Synchronize(frmInProgress.UpdateGauge);
    end;
  end;
end;

procedure TfrmMICROCHIP_PIC_ICP.Tr_ReadChipMemoryToBuf(ArIndx:integer; // индекс области программирования
                                var Buf:TDataBuf;                     //
                                cmd:integer);                     // команда
var
  firstAddr,lastAddr:Word;
//  InBuf:TThreadBuf;
  indx:Longint;
//  bufStr:string;
  k:Cardinal;
  DataWord:DWORD;
  ActualBitN:Integer;


begin
  with FSendThread do
  begin
    firstAddr:=AreasData[ArIndx].DataArr[0];
    lastAddr:=AreasData[ArIndx].DataArr[1];
    ActualBitN:=AreasData[ArIndx].DataArr[2];
    FDataMask:=GetDataMask(ActualBitN);


    k:= (lastAddr-firstAddr+1);  //  Количество читаемых слов
    for indx:=1 to k do
    begin
      if  Terminated then abort;
      SendCmdToChip(cmd);
      DataWord:=ReadDataFromChip;
      if  ActualBitN>8 then
      begin
        Buf[(indx-1)*2+1]:=DataWord and $FF;
        Buf[(indx-1)*2]:= DataWord shr 8;
      end
      else
      begin
        Buf[indx-1]:=DataWord and $FF;
      end;
      SendCmdToChip(6); // Команда увеличения адреса

    end;
  end;
end;



procedure TfrmMICROCHIP_PIC_ICP.Tr_ReadProcess;
var ArIndx:integer;
    DataBuf:TDataBuf;
//    str:string;


  procedure ReadCONFIG(strID:string);
  var i,j:integer;
      strMask:string;
      b,b_src:word;
  begin
    SendCmdToChip(0);
    SendDataToChip(0);
    for i:=1 to 7 do SendCmdToChip($06); // Путем инкремента установить указатель на слово конфигурации
    Tr_ReadChipMemoryToBuf(ArIndx,DataBuf,4);
    b:=(DataBuf[0] shl 8) or DataBuf[1];

    if FVerify then
    begin
      b_src:=CollectNodesData(strID);
      if b<>b_src then
        StrList_ErrorsRep.Add(strID+' '+format('  Source: %4.4x <> Chip: %4.4x',[b_src,b]));
    end
    else
      // Поиск всех установок связанных с
      // данной областью
      for i:=0 to HIGH(NodesData) do
        if NodesData[i].strAreaID=strID then
        begin
          // Обработка соответствующего узла
          with trvParameters.Items[i] do
          begin
            if not HasChildren then break;
            // перебор субузлов заданного узла
            for j:=0 to count-1 do
            begin
              strMask:=NodesData[Item[j].AbsoluteIndex].strMask ;
              if CompareWithMask(b,strMask) then
                SelectSubNode(trvParameters.Items[i],trvParameters.Items[i].Item[j]);
            end;
          end; {with }
        end;
  end;

  procedure ReadID;
  var indx:integer;
      st:string;
      b:word;
  begin
    SendCmdToChip(0);
    SendDataToChip(0);
    Tr_ReadChipMemoryToBuf(ArIndx,DataBuf,4);
    // Заполнить значение поля ID
    b:=(DataBuf[0] and $f) shl 4;
    b:=(b or (DataBuf[1] and $f)) shl 4;
    b:=(b or (DataBuf[2] and $f)) shl 4;
    b:=b or (DataBuf[3] and $f);
    st:=Format('%4.4x',[b]);

    // Найти индекс узла с заданным названием
    if FindNodeIndex('ID',indx) then
      if FVerify then
        if st<>trvParameters.Items[indx].item[0].text then
           StrList_ErrorsRep.Add('ID       Source: '+trvParameters.Items[indx].item[0].text+' <> Chip: '+st)


      else
        trvParameters.Items[indx].Text:=NodesData[indx].strCapt+' : '+st;


  end;



begin
  with FSendThread do
  begin
//    if not CommPort.Enabled then CommPort.Open;
    try
      PurgePort;

      for ArIndx:=0 to lsvAreas.Items.Count-1 do
        If lsvAreas.Items[ArIndx].Checked then
        begin
          if AreasData[ArIndx].strID='CODE' then
          begin
            // Чтение памяти программ
            Tr_ResetChip;
            Tr_ReadChipMemoryToGrid(ArIndx,frmMain.CodeGrid,$04);

          end;
          if AreasData[ArIndx].strID='EEPROM' then
          begin
            // Чтение памяти данных
            Tr_ResetChip;
            Tr_ReadChipMemoryToGrid(ArIndx,frmMain.EEPROMGrid,$05);
          end;

          if AreasData[ArIndx].strID='CONFIG' then
          begin
            // Чтение слова конфигурации
            Tr_ResetChip;
            ReadCONFIG('CONFIG')
          end;
          if AreasData[ArIndx].strID='ID' then
          begin
            // Чтение идентификатора
            Tr_ResetChip;
            ReadID
          end;
        end;
    finally
      // Снять напряжение со всех выводов

      Pin_MCLR:=0;
      Pin_Data:=0;
      Pin_Clock:=0;


//      CommPort.Close;
      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;



Procedure TfrmMICROCHIP_PIC_ICP.Tr_ProgramChipFromGrid(ArIndx:integer;
                                             Grid:THexGrid;
                                             cmd:integer);
var
  firstAddr,lastAddr:Word;
  k:Cardinal;
  indx:Longint;
  ActualBitN:Integer;

begin
  with FSendThread do
  begin
    Synchronize(frmInProgress.InitGauge);
    ActualBitN:=AreasData[ArIndx].DataArr[2];
    // Перевести в исчисление в байтах
    firstAddr:=AreasData[ArIndx].DataArr[0];
    lastAddr:=(AreasData[ArIndx].DataArr[1]+1)-1;

    FDataMask:=GetDataMask(ActualBitN);

    k:= (lastAddr-firstAddr+1);
    for indx:=1 to k do
    begin
      if  Terminated then abort;
      SendCmdToChip(cmd);
      if  ActualBitN>8 then
      begin
        SendDataToChip((Grid.Adata[(indx-1)*2] shl 8) or Grid.Adata[(indx-1)*2+1]);
      end
      else
      begin
        SendDataToChip(Grid.Adata[indx-1]);
      end;
      SendCmdToChip($08);
      sleep(6);
      if F_endprog_req then SendCmdToChip($E);
      SendCmdToChip(6); // Команда увеличения адреса

      frmInProgress.ProgrPos:=Round(100*indx/k);
      Synchronize(frmInProgress.UpdateGauge);

    end;
  end;
end;

function TfrmMICROCHIP_PIC_ICP.CollectNodesData(strID:string):word ;
var b:word;
    i:integer;
    strMask:string;
begin
  b:=0;
  for i:=0 to HIGH(NodesData) do
    if NodesData[i].strAreaID=strID then
    begin
      // Обработка соответствующего узла
      with trvParameters.Items[i] do
      begin
        if not HasChildren then break;
        strMask:=NodesData[NodesData[i].intSelSubIt].strMask ;
        b:=SetByMask(b,strMask);
      end; {with }
    end;
  CollectNodesData:=b;

end;



procedure TfrmMICROCHIP_PIC_ICP.Tr_WriteProcess;
var ArIndx:integer;
//    DataBuf:array[0..127] of byte;


  procedure WriteCONFIG(strID:string);
  var i:integer;
  begin
    // Поиск всех установок связанных с
    // данной областью

    SendCmdToChip(0);
    SendDataToChip(CollectNodesData(strID));
    for i:=1 to 7 do SendCmdToChip($06); // Путем инкремента установить указатель на слово конфигурации
    SendCmdToChip($08);
    sleep(5);
    if F_endprog_req then SendCmdToChip($E);

  end;

  procedure WriteID;
  var indx:integer;
      b:word;
      st:string;
  begin
    // Найти индекс узла с заданным названием
    SendCmdToChip(0);
    SendDataToChip(0);

    if FindNodeIndex('ID',indx) then
    begin
      st:=trvParameters.Items[indx].item[0].text;
      b:=StrToInt('$'+st);
      SendCmdToChip(2);
      SendDataToChip((b shr 12) and $F);
      SendCmdToChip(8);
      sleep(5);
      if F_endprog_req then SendCmdToChip($E);
      SendCmdToChip(6);

      SendCmdToChip(2);
      SendDataToChip((b shr 8) and $F);
      SendCmdToChip(8);
      sleep(5);
      if F_endprog_req then SendCmdToChip($E);
      SendCmdToChip(6);

      SendCmdToChip(2);
      SendDataToChip((b shr 4) and $F);
      SendCmdToChip(8);
      sleep(5);
      if F_endprog_req then SendCmdToChip($E);
      SendCmdToChip(6);

      SendCmdToChip(2);
      SendDataToChip(b and $F);
      SendCmdToChip(8);
      sleep(5);
      if F_endprog_req then SendCmdToChip($E);
      SendCmdToChip(6);
    end;
  end;


begin
  with FSendThread do
  begin
    try
      PurgePort;
      Pin_MCLR:=1; // Включить режим программирования

      for ArIndx:=0 to lsvAreas.Items.Count-1 do
        If lsvAreas.Items[ArIndx].Checked then
        begin
          if AreasData[ArIndx].strID='CODE' then
          begin
            Tr_ResetChip;
            Tr_ProgramChipFromGrid(ArIndx,frmMain.CodeGrid,2);
          end;
          if AreasData[ArIndx].strID='EEPROM' then
          begin
            Tr_ResetChip;
            Tr_ProgramChipFromGrid(ArIndx,frmMain.EEPROMGrid,3);
          end;
          if AreasData[ArIndx].strID='CONFIG' then
          begin
            Tr_ResetChip;
            WriteCONFIG('CONFIG');
          end;
          if AreasData[ArIndx].strID='ID' then
          begin
            Tr_ResetChip;
            WriteID;
          end;
        end;
    finally
      // Снять напряжение со всех выводов
      Pin_MCLR:=0;
      Pin_Data:=0;
      Pin_Clock:=0;

      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;





procedure TfrmMICROCHIP_PIC_ICP.Tr_EraseProcess;
var i:integer;
begin
  with FSendThread do
  begin
//    if not CommPort.Enabled then CommPort.Open;
    try
      PurgePort;
      Pin_MCLR:=1; // Включить режим программирования
      if F_endprog_req then
      begin
        SendCmdToChip($9);
        SendCmdToChip($08);
        sleep(20);
      end
      else
      begin
        SendCmdToChip(0);
        SendDataToChip($FFFF);
        for i:=1 to 7 do SendCmdToChip($06); // Путем инкремента установить указатель на слово конфигурации
  //      SendCmdToChip(2);
  //      SendDataToChip($ffff);
        SendCmdToChip($01);
        SendCmdToChip($07);
        SendCmdToChip($08);
        sleep(20);
        SendCmdToChip($01);
        SendCmdToChip($07);
      end;
    finally
      // Снять напряжение со всех выводов
      Pin_MCLR:=0;
      Pin_Data:=0;
      Pin_Clock:=0;

//      CommPort.Close;
      // Закрыть окно InProgress
      PostMessage(frmInProgress.Handle,wm_ThreadDoneErrMsg,0,0);
    end;
  end; {with FSendThread}
end;






initialization
   SetLength(ConstructorsList, Length(ConstructorsList)+1);
   ConstructorsList[High(ConstructorsList)].name:='TfrmMICROCHIP_PIC_ICP';
   ConstructorsList[High(ConstructorsList)].ClassName:=TfrmMICROCHIP_PIC_ICP;
end.
