dbgclass.pas

Borland Pascal写的8051单片机模拟仿真器。内有源码

  l,j:word;
  n:byte;
  kol:PStrCollection;
  Bufor:array[0..63] of char;
  linia:string[63];
  linia1,adres:string[4];
  bitnr:char;
begin
  Symb:=GetWindow(Okno,gw_Child);
  l:=GetWindowWord(Okno,0);
  case l of
    0: kol:=SymbROM;
    1: kol:=SymbRAM;
    2: kol:=SymbReg;
    3: kol:=SymbBit;
  end;
  if kol^.Count=0 then
  begin
    MessageBeep(mb_IconHand);
    Exit;
  end;
  j:=SendMessage(Symb,lb_GetCaretIndex,0,0);
  if SendMessage(Symb,lb_GetSel,j,0)=0 then
  begin
    MessageBeep(mb_IconHand);
    Exit;
  end;
  SendMessage(Symb,lb_GetText,j,longint(@Bufor));
  linia:=StrPas(Bufor);
  n:=Pos(#9,linia);
  linia1:=Copy(linia,1,n-1);
  Delete(linia,1,n);
  if l<3 then adres:=linia1 else
  begin
    adres:=Copy(linia1,1,2);
    bitnr:=linia1[4];
  end;
  n:=Pos(#9,linia);
  Delete(linia,1,n);
  StrPCopy(buforzn1,linia);
  StrPCopy(buforzn2,adres);
  if l=3 then StrPCopy(buforzn3,bitnr);
  if DodajSymb(Okno,true) then
  begin
    SetFocus(Symb);
    j:=SendMessage(Symb,lb_GetCaretIndex,0,0);
    SendMessage(Symb,lb_SetCurSel,j,0);
    Exit;
  end;
  kol^.AtDelete(j);
  kol^.Insert(StrNew(buforzn1));
  OdrysujOkna(6); {Symb}
  if l=0 then
  begin
    OdrysujOkna(0); {Instr}
    OdrysujOkna(8); {Brk}
  end;
  SetFocus(Symb);
  j:=SendMessage(Symb,lb_GetCaretIndex,0,0);
  SendMessage(Symb,lb_SetCurSel,j,0);
end;

procedure UsunAllSymb(Okno:HWnd);
var
  l:word;
  kol:PStrCollection;
begin
  l:=GetWindowWord(Okno,0);
  case l of
    0: kol:=SymbROM;
    1: kol:=SymbRAM;
    2: kol:=SymbReg;
    3: kol:=SymbBit;
  end;
  if kol^.Count=0 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(Okno,Napis1(6),'Debugger 8051',mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if BWCCMessageBox(Okno,Napis1(7),'Debugger 8051',mb_OKCancel or mb_TaskModal or
    mb_IconQuestion)<>1 then Exit;
  kol^.DeleteAll;
  OdrysujOkna(6); {Symb}
  if l=0 then
  begin
    OdrysujOkna(0); {Instr}
    OdrysujOkna(8); {Brk}
  end;
end;

procedure ZmienJezykSymb(Okno:HWnd);
begin
  SetWindowText(GetDlgItem(Okno,505),Napis1(60));
  SetWindowText(GetDlgItem(Okno,506),Napis1(61));
  SetWindowText(GetDlgItem(Okno,507),Napis1(62));
  SetWindowText(GetDlgItem(Okno,508),Napis1(63));
end;

function FunSymbView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
const
  TabuS:array[0..1] of integer=(23,36);
  NazwyB:array[0..3] of PChar=('EPROM','RAM','REG','BIT');
var
  Symb:HWnd;
  i:word;
begin
  FunSymbView:=0;
  case Kod_meldunku of
    wm_Create        : begin
                         SetWindowWord(Okno,0,0);
                         Symb:=CreateWindow('LISTBOX','',ws_Child or ws_Visible or lbs_Standard
                           or lbs_UseTabStops or lbs_WantKeyboardInput,0,0,270,226,Okno,500,
                           hInstance,nil);
                         SendMessage(Symb,lb_SetTabStops,2,longint(@TabuS));
                         for i:=0 to 3 do
                           CreateWindow('BUTTON',NazwyB[i],ws_Child or ws_Visible,
                           271,i*25,95,25,Okno,501+i,hInstance,nil);
                         for i:=0 to 3 do
                           CreateWindow('BUTTON',Napis1(60+i),ws_Child or ws_Visible,
                           271,100+i*25,95,25,Okno,505+i,hInstance,nil);
                         OdnowSymb(Okno);
                       end;
    wm_Command       : case wParam of
                         500: if HiWord(LParam)=lbn_DblClk then ZmienSymb(Okno);
                         501..504      : begin
                                           SetWindowWord(Okno,0,wParam-501);
                                           OdnowSymb(Okno);
                                         end;
                         505           : DodajSymb(Okno,false);
                         506           : UsunSymb(Okno);
                         507           : UsunAllSymb(Okno);
                         508           : ZmienSymb(Okno);
                         us_ZmianaJez  : ZmienJezykSymb(Okno);
                         us_OdnowWidok : begin
                                           OdnowSymb(Okno);
                                           UpdateWindow(Okno);
                                         end;
                       end;
    wm_VKeyToItem    : if (HWnd(LoWord(LParam))=GetDlgItem(Okno,500)) and (wParam=VK_RETURN)
                       then begin
                         ZmienSymb(Okno);
                         FunSymbView:=-2;
                       end else FunSymbView:=-1;
  else FunSymbView:=DefWindowProc(Okno,Kod_meldunku,WParam,LParam);
  end;
end;

procedure OdnowInstr(Okno:HWnd);
var
  o:HWnd;
  adr:PAdresy;
begin
  o:=GetDlgItem(Okno,500);
  adr:=pointer(GetWindowLong(Okno,0));
  SendMessage(o,wm_SetRedraw,0,0);
  redr:=0;
  SendMessage(o,lb_ResetContent,0,0);
  WypelnijInstr(o,pointer(GetWindowLong(Okno,0)));
  SendMessage(o,wm_SetRedraw,1,0);
  redr:=1;
  SendMessage(o,lb_SetCurSel,GetWindowWord(Okno,4),0);
  SetScrollPos(GetDlgItem(Okno,501),sb_Ctl,adr^[1] shr 2,true);
  InvalidateRect(GetDlgItem(Okno,503),nil,false);
  UpdateWindow(GetDlgItem(Okno,503));
end;

procedure SkokGora(Okno,Suw:HWnd;hurt:boolean);
var
  q:string[30];
  dl:byte;
  z,off,sta:word;
  adr:PAdresy;
begin
  z:=GetWindowWord(Okno,4);
  if z>0 then
  begin
    Dec(z);
    SetWindowWord(Okno,4,z);
    if not hurt then SendMessage(GetDlgItem(Okno,500),lb_SetCurSel,z,0);
    Exit;
  end;
  adr:=pointer(GetWindowLong(Okno,0));
  off:=adr^[1];
  if off=0 then Exit;
  sta:=off;
  q:=Deasm(off-1);
  dl:=1;
  if q[1]<>#1 then
  begin
    q:=Deasm(off-2);
    if q[1]=#2 then dl:=2 else
    begin
      q:=Deasm(off-3);
      if q[1]=#3 then dl:=3;
    end;
  end;
  if longint(off)-dl<0 then Exit;
  adr^[1]:=off-dl;
  if (adr^[1]<>sta) and (hurt=false) then OdnowInstr(Okno);
end;

procedure SkokDol(Okno,Suw:HWnd;hurt:boolean);
var
  Inst:HWnd;
  z,off,ile:word;
  code:integer;
  q:string[30];
  w:string[50];
  e:array[0..50] of char;
  tmp:array[1..19] of word;
  dl,x:byte;
  adr:PAdresy;
begin
  z:=GetWindowWord(Okno,4);
  Inst:=GetDlgItem(Okno,500);
  ile:=SendMessage(Inst,lb_GetCount,0,0);
  if z<ile-1 then
  begin
    Inc(z);
    SetWindowWord(Okno,4,z);
    if not hurt then SendMessage(Inst,lb_SetCurSel,z,0);
    Exit;
  end;
  adr:=pointer(GetWindowLong(Okno,0));
  off:=adr^[20];
  if off=$FFFF then Exit;
  q:=Deasm(off);
  if longint(off)+byte(q[1])>65535 then Exit;
  Move(adr^[2],tmp,SizeOf(tmp));
  Move(tmp,adr^[1],SizeOf(tmp));
  Inc(off,byte(q[1]));
  adr^[20]:=off;
  if hurt then Exit;
  q:=Deasm(off);
  dl:=byte(q[1]);
  Delete(q,1,1);
  w:=WtoHEX(off)+':'#9;
  for x:=1 to dl do
  begin
    w:=w+BtoHEX(Mem[selROM:off+x-1]);
    if x<dl then w:=w+' ';
  end;
  w:=w+#9+q;
  StrPCopy(e,w);
  SendMessage(Inst,lb_DeleteString,0,0);
  SendMessage(Inst,lb_AddString,0,longint(@e));
  SetWindowWord(Okno,4,19);
  SendMessage(Inst,lb_SetCurSel,19,0);
  SetScrollPos(Suw,sb_Ctl,adr^[1] shr 2,true);
  InvalidateRect(GetDlgItem(Okno,503),nil,false);
end;

procedure SkokSGora(Okno,Suw:HWnd);
var
  adr:PAdresy;
  n:byte;
begin
  adr:=pointer(GetWindowLong(Okno,0));
  if (adr^[1]=0) and (GetWindowWord(Okno,4)=0) then Exit;
  for n:=1 to 19 do SkokGora(Okno,Suw,true);
  OdnowInstr(Okno);
end;

procedure SkokSDol(Okno,Suw:HWnd);
var n:byte;
begin
  for n:=1 to 19 do SkokDol(Okno,Suw,true);
  OdnowInstr(Okno);
end;

procedure PrzewinInstr(Okno:HWnd;wScrollCode,nPos:word;hwndCtl:HWnd);
var
  adr:PAdresy;
  ad,z:word;
begin
  case wScrollCode of
    sb_LineUp        : SkokGora(Okno,hwndCtl,false);
    sb_LineDown      : SkokDol(Okno,hwndCtl,false);
    sb_PageUp        : SkokSGora(Okno,hwndCtl);
    sb_PageDown      : SkokSDol(Okno,hwndCtl);
    sb_ThumbTrack    : begin
                         adr:=pointer(GetWindowLong(Okno,0));
                         adr^[1]:=nPos*4;
                         SetWindowWord(Okno,4,0);
                         OdnowInstr(Okno);
                       end;
    end;
end;

procedure DblClickInstr(Okno:HWnd);
var
  adr:PAdresy;
  Inst:HWnd;
  b:byte;
  ad,z:word;
  q:string[6];
begin
  Inst:=GetDlgItem(Okno,500);
  z:=GetWindowWord(Okno,4);
  SendMessage(Inst,lb_SetCurSel,z,0);
  adr:=pointer(GetWindowLong(Okno,0));
  ad:=adr^[z+1];
  b:=PokazDialog('ASEMBL',@FunOffset);
  if (b<>1) or (wynik='') then
  begin
    SetFocus(Inst);
    Exit;
  end;
  q:=Reasm(ad,wynik);
  if q='' then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(3),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    SetFocus(Inst);
    Exit;
  end;
  if Copy(q,1,4)='GOGO' then
  begin
    adr^[1]:=256*byte(q[6])+byte(q[5]);
    SetWindowWord(Okno,4,0);
    OdrysujOkna(0); {Instr}
    OdrysujOkna(3); {HEX ROM}
    OdnowInstr(Okno);
    SetFocus(Inst);
    PostMessage(Okno,wm_Command,500,MakeLong(0,lbn_DblClk));
    Exit;
  end;
  if longint(ad)+Length(q)>65536 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(4),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    SetFocus(Inst);
    Exit;
  end;
  for b:=0 to Length(q)-1 do Mem[selROM:ad+b]:=byte(q[b+1]);
  if longint(ad)+Length(q)>65535 then
  begin
    OdrysujOkna(0); {Instr}
    OdrysujOkna(3); {HEX ROM}
    SetFocus(Inst);
    Exit;
  end;
  if z<19 then Inc(z) else adr^[1]:=adr^[2];
  SetWindowWord(Okno,4,z);
  OdrysujOkna(0); {Instr}
  OdrysujOkna(3); {HEX ROM}
  OdnowInstr(Okno);
  PostMessage(Okno,wm_Command,500,MakeLong(0,lbn_DblClk));
end;

procedure SkokInstr(Okno:HWnd);
var
  code,b:integer;
  off:word;
  adr:PAdresy;
begin
  b:=PokazDialog('ADRSKOKU',@FunOffset);
  if b<>1 then Exit;
  if wynik='' then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(66),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if wynik='PC' then off:=RejPC else
  begin
    Val('$'+wynik,off,code);
    if code<>0 then
    begin
      MessageBeep(mb_IconHand);
      BWCCMessageBox(0,Napis1(1),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
      Exit;
    end;
  end;
  adr:=pointer(GetWindowLong(Okno,0));
  adr^[1]:=off;
  SetWindowWord(Okno,4,0);
  OdnowInstr(Okno);
end;

procedure LecimyInstr(Okno:HWnd);
var
  adr:PAdresy;
  i,ile:byte;
  off:word;
  Inst:HWnd;
begin
  adr:=pointer(GetWindowLong(Okno,0));
  Inst:=GetDlgItem(Okno,500);
  ile:=SendMessage(Inst,lb_GetCount,0,0);
  if (RejPC<adr^[1]) or (RejPC>adr^[ile]) then
  begin
    adr^[1]:=RejPC;
    SetWindowWord(Okno,4,0);
    Exit;
  end;
  for i:=1 to ile do
    if RejPC=adr^[i] then
    begin
      SetWindowWord(Okno,4,i-1);
      Exit;
    end;
  adr^[1]:=RejPC;
  SetWindowWord(Okno,4,0);
end;

procedure NarysujLinie(Okno:HWnd;lpdis:PDrawItemStruct);
const Kolory:array[0..7] of longint=(0,$ffffff,$ffffff,$800000,$ffffff,$ff,$ffffff,$ff00ff);
var
  buf:array[0..63] of char;
  br:HBrush;
  adr:PAdresy;
  i:byte;
  b:HBitmap;
  DC:HDC;
  R:TRect;
begin
  if redr=0 then Exit;
  R:=lpdis^.rcItem;
  OffsetRect(R,-R.left,-R.top);
  b:=CreateCompatibleBitmap(lpdis^.HDC,R.right,R.bottom);
  DC:=CreateCompatibleDC(lpdis^.HDC);
  SelectObject(DC,b);
  SetBkMode(DC,TRANSPARENT);
  adr:=pointer(GetWindowLong(Okno,0));
  if (lpdis^.itemState and ods_Selected)=0 then i:=0 else i:=2;
  if ZnajdzSymb(SymbBrk,WtoHEX(adr^[lpdis^.itemID+1]))<>-1 then i:=i+4;
  SetTextColor(DC,Kolory[i]);
  SetBkColor(DC,Kolory[i+1]);
  br:=CreateSolidBrush(Kolory[i+1]);
  FillRect(DC,R,br);
  DeleteObject(br);
  SendMessage(lpdis^.hwndItem,lb_GetText,lpdis^.itemID,longint(@buf));
  TabbedTextOut(DC,0,0,buf,StrLen(buf),3,Tabul,0);
  if (lpdis^.itemState and ods_Focus)<>0 then DrawFocusRect(DC,R);
  BitBlt(lpdis^.HDC,lpdis^.rcItem.left,lpdis^.rcItem.top,R.right,R.bottom,DC,0,0,SrcCopy);
  DeleteDC(DC);
  DeleteObject(b);
end;

function FunInstrView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
var
  Ins,Suw:HWnd;
  adr:PAdresy;
  off:word;
  i:integer;
  Info:PMeasureItemStruct;
begin
  FunInstrView:=0;
  case Kod_meldunku of
    wm_Create  : begin
                   GetMem(adr,40); {pami赕 na tablic