dbgclass.pas

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

    wm_Paint         : RysujBitki(Okno,true);
    wm_LButtonDown   : ZmienBitki(LoWord(LParam),HiWord(LParam),GetParent(Okno));
    wm_Command       : if wParam=us_OdnowWidok then RysujBitki(Okno,false);
  else FunBitView:=DefWindowProc(Okno,Kod_meldunku,WParam,LParam);
  end;
end;

procedure RysujMover(Okno:HWnd);
var
  Paint:TPaintStruct;
  DC:HDC;
  R:TRect;
begin
  GetClientRect(Okno,R);
  DC:=BeginPaint(Okno,Paint);
  BitBlt(DC,0,0,R.right+1,R.bottom+1,HDC(GetWindowWord(Okno,4)),0,0,SRCCOPY);
  EndPaint(Okno,Paint);
end;

procedure CzasMover(Okno:HWnd);
var
  DC,mdc:HDC;
  szer:word;
  R:TRect;
  zn:word;
  akt,tmp:PChar;
  a:array[0..40] of char;
  li:byte;
begin
  li:=GetWindowWord(Okno,8);
  zn:=GetWindowWord(Okno,10);
  GetClientRect(Okno,R);
  DC:=GetDC(Okno);
  mdc:=GetWindowWord(Okno,4);
  BitBlt(mdc,0,0,R.right+1,R.bottom+32,mdc,0,1,SRCCOPY);
  BitBlt(DC,0,0,R.right+1,R.bottom+1,mdc,0,0,SRCCOPY);
  akt:=MoverString+zn;
  if li<20 then Inc(li) else
  begin
    li:=0;
    tmp:=StrScan(akt,#13);
    if tmp=nil then zn:=0 else
    begin
      if tmp<>akt then
      begin
        StrLCopy(a,akt,tmp-akt);
        szer:=LoWord(GetTextExtent(mdc,a,StrLen(a)));
        TextOut(mdc,(R.right+1-szer) div 2,R.bottom+1,a,StrLen(a));
      end else li:=10;
      zn:=tmp-MoverString+1;
    end;
  end;
  ReleaseDC(Okno,DC);
  SetWindowWord(Okno,8,li);
  SetWindowWord(Okno,10,zn);
end;

function FunMoverView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
var
  DC,mdc:HDC;
  b:HBitmap;
  f:HFont;
  R:TRect;
begin
  FunMoverView:=0;
  case Kod_meldunku of
    wm_Create           : begin
                            GetClientRect(Okno,R);
                            DC:=GetDC(Okno);
                            b:=CreateCompatibleBitmap(DC,R.right+1,R.bottom+33);
                            mdc:=CreateCompatibleDC(DC);
                            SelectObject(mdc,b);
                            SelectObject(mdc,GetStockObject(LTGRAY_BRUSH));
                            SetBkColor(mdc,$00C0C0C0);
                            SetTextColor(mdc,$800080);
                            Rectangle(mdc,-1,-1,R.right+1,R.bottom+34);
                            ReleaseDC(Okno,DC);
                            f:=CreateFont(18,0,0,0,FW_BOLD,0,0,0,0,0,0,0,
                              VARIABLE_PITCH or FF_SWISS,'Times New Roman');
                            SelectObject(mdc,f);
                            SetWindowWord(Okno,0,SetTimer(Okno,1,30,nil));
                            SetWindowWord(Okno,2,b);
                            SetWindowWord(Okno,4,mdc);
                            SetWindowWord(Okno,6,f);
                            SetWindowWord(Okno,8,19); {li=19}
                            SetWindowWord(Okno,10,0); {zn=0}
                          end;
    wm_Destroy          : begin
                            KillTimer(Okno,GetWindowWord(Okno,0));
                            DeleteDC(GetWindowWord(Okno,4));
                            DeleteObject(GetWindowWord(Okno,2));
                            DeleteObject(GetWindowWord(Okno,6));
                            DefWindowProc(Okno,wm_Destroy,WParam,LParam);
                          end;
    wm_Paint            : RysujMover(Okno);
    wm_Timer            : CzasMover(Okno);
  else FunMoverView:=DefWindowProc(Okno,Kod_meldunku,WParam,LParam);
  end;
end;

procedure RysujStan(Okno:HWnd;auto:boolean);
var
  Paint:TPaintStruct;
  DC,m:HDC;
  txt:string[10];
  a:array[0..19] of char;
  b:HBitmap;
begin
  if auto then DC:=BeginPaint(Okno,Paint) else DC:=GetDC(Okno);
  m:=CreateCompatibleDC(DC);
  b:=LoadBitmap(hInstance,'INTSTATE');
  SelectObject(m,b);
  SetBkColor(DC,$00c0c0c0);
  SetTextColor(DC,0);
  SelectObject(DC,CzcionkaOEM);
  StrPCopy(a,'PC: '+WtoHEX(RejPC)+' ');
  TextOut(DC,2,1,a,9);
  if licznikcykli<0 then licznikcykli:=0;
  Str(licznikcykli,txt);
  StrCopy(a,Napis1(82));
  StrPCopy(@a[StrLen(a)],': '+txt+'      ');
  SetTextColor(DC,$000000ff);
  TextOut(DC,36+FontOEMszer*8,1,a,StrLen(a));
  BitBlt(DC,6+FontOEMszer*8,2,26,29,m,intflipflop*26,0,SrcCopy);
  DeleteDC(m);
  DeleteObject(b);
  if auto then EndPaint(Okno,Paint) else ReleaseDC(Okno,DC);
end;

procedure DblClickStan(Okno:HWnd;xPos:word);
var
  b:integer;
  off:word;
begin
  if xPos>70 then
  begin
    if xPos>100 then
    begin
      licznikcykli:=0;
      OdrysujOkna(7); {Stan}
    end;
    Exit;
  end;
  b:=PokazDialog('REJESTR',@FunOffset);
  if (b<>1) or (wynik='') then Exit;
  Val('$'+wynik,off,b);
  if b<>0 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(1),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  RejPC:=off;
  OdrysujOkna(0); {Instr}
  OdrysujOkna(7); {Stan}
end;

function FunStanView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
begin
  FunStanView:=0;
  case Kod_meldunku of
    wm_Paint         : RysujStan(Okno,true);
    wm_LButtonDblClk : DblClickStan(Okno,LoWord(LParam));
    wm_Command       : if (wParam=us_OdnowWidok) or
                          (wParam=us_ZmianaJez) then RysujStan(Okno,false);
  else FunStanView:=DefWindowProc(Okno,Kod_meldunku,WParam,LParam);
  end;
end;

procedure OdnowReje(Okno:HWnd);
var
  Reje:HWnd;
  i,a,poczr:byte;
  tmp:array[0..50] of char;
  aktb:string[2];
begin
  Reje:=GetWindow(Okno,gw_Child);
  if SendMessage(Reje,lb_GetCount,0,0)<>0 then SendMessage(Reje,lb_ResetContent,0,0);
  for i:=0 to 19 do
  begin
    a:=HEXtoB(Copy(Rejestry[i],1,2));
    aktb:=BtoHEX(Mem[selRAMInt:a]);
    StrPCopy(tmp,' '+Copy(Rejestry[i],5,255)+#9'= '+aktb);
    Move(aktb[1],Rejestry[i,3],2);
    SendMessage(Reje,lb_AddString,0,longint(@tmp));
  end;
  poczr:=Mem[selRAMInt:$D0] and $18; { bity: RS0 i RS1 }
  for i:=20 to 27 do     { rejestry R0..R7 }
  begin
    a:=HEXtoB(Copy(Rejestry[i],1,2))+poczr;
    aktb:=BtoHEX(Mem[selRAMInt:a]);
    StrPCopy(tmp,' '+Copy(Rejestry[i],5,255)+#9'= '+aktb);
    Move(aktb[1],Rejestry[i,3],2);
    SendMessage(Reje,lb_AddString,0,longint(@tmp));
  end;
end;

procedure ZmianaRej(Okno:HWnd);
var
  Reje:HWnd;
  b:integer;
  off,i:word;
  poczr:byte;
begin
  Reje:=GetWindow(Okno,gw_Child);
  i:=SendMessage(Reje,lb_GetCurSel,0,0);
  b:=PokazDialog('REJESTR',@FunOffset);
  if (b<>1) or (Length(wynik)>2) or (wynik='') then Exit;
  Val('$'+wynik,off,b);
  if b<>0 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(1),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if off>255 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(9),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if i>19 then
    poczr:=Mem[selRAMInt:$D0] and $18 else poczr:=0;  { czy R0..R7 ? }
  Mem[selRAMInt:poczr+HEXtoB(Copy(Rejestry[i],1,2))]:=off;
  OdnowReje(Okno);
  OdrysujOkna(1); {Reg}
  OdrysujOkna(2); {Bit}
  OdrysujOkna(5); {HEX RAM Int}
  OdrysujOkna(6); {Symb}
  OdrysujOkna(9); {Porty}
end;

function FunRegsView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
const TabuR:integer=24;
var Reje:HWnd;
begin
  FunRegsView:=0;
  case Kod_meldunku of
    wm_Create        : begin
                         Reje:=CreateWindow('KLASALISTB','',ws_Child or ws_Visible or
                           ws_Border or lbs_UseTabStops or lbs_MultiColumn or lbs_Notify,
                           0,0,190,226,Okno,500,hInstance,nil);
                         SendMessage(Reje,lb_SetTabStops,1,longint(@TabuR));
                         SendMessage(Reje,lb_SetColumnWidth,100,0);
                         OdnowReje(Okno);
                       end;
    wm_Command       : case wParam of
                         500           : if HiWord(LParam)=lbn_DblClk then ZmianaRej(Okno);
                         us_OdnowWidok : begin
                                           OdnowReje(Okno);
                                           UpdateWindow(Okno);
                                         end;
                       end;
    wm_VKeyToItem    : if (HWnd(LoWord(LParam))=GetDlgItem(Okno,500)) and (wParam=VK_RETURN)
                       then begin
                         ZmianaRej(Okno);
                         FunRegsView:=-2;
                       end else FunRegsView:=-1;
  else FunRegsView:=DefWindowProc(Okno,Kod_meldunku,WParam,LParam);
  end;
end;

procedure OdnowSymb(Okno:HWnd);
var
  Symb,ok:HWnd;
  kol:PStrCollection;
  l,i:word;
  b:char;
  s:string[40];
  a:array[0..40] of char;
begin
  Symb:=GetWindow(Okno,gw_Child);
  l:=GetWindowWord(Okno,0);
  for i:=0 to 3 do
  begin
    ok:=GetDlgItem(Okno,501+i);
    if l=i then EnableWindow(ok,false) else EnableWindow(ok,true);
  end;
  SendMessage(Symb,wm_SetRedraw,0,0);
  if SendMessage(Symb,lb_GetCount,0,0)<>0 then SendMessage(Symb,lb_ResetContent,0,0);
  case l of
    0: kol:=SymbROM;
    1: kol:=SymbRAM;
    2: kol:=SymbReg;
    3: kol:=SymbBit;
  end;
  if l=0 then
  begin
    if kol^.Count>0 then
      for i:=0 to kol^.Count-1 do
      begin
        s:=StrPas(kol^.At(i));
        StrPCopy(a,Copy(s,1,4)+#9#9+Copy(s,5,255));
        SendMessage(Symb,lb_AddString,0,longint(@a));
      end;
  end else if l=1 then
  begin
    if kol^.Count>0 then
      for i:=0 to kol^.Count-1 do
      begin
        s:=StrPas(kol^.At(i));
        StrPCopy(a,Copy(s,1,4)+#9+BtoHEX(Mem[selRAM:HEXtoW(Copy(s,1,4))])+#9+Copy(s,5,255));
        SendMessage(Symb,lb_AddString,0,longint(@a));
      end;
  end else if l=2 then
  begin
    if kol^.Count>0 then
      for i:=0 to kol^.Count-1 do
      begin
        s:=StrPas(kol^.At(i));
        StrPCopy(a,Copy(s,3,2)+#9+BtoHEX(Mem[selRAMInt:HEXtoB(Copy(s,3,2))])+#9+Copy(s,5,255));
        SendMessage(Symb,lb_AddString,0,longint(@a));
      end;
  end else if l=3 then
    if kol^.Count>0 then
      for i:=0 to kol^.Count-1 do
      begin
        s:=StrPas(kol^.At(i));
        if (Mem[selRAMInt:HEXtoW(Copy(s,3,2))] and Maski[HEXtoB(s[2])])=0 then
          b:='0' else b:='1';
        StrPCopy(a,Copy(s,3,2)+'.'+s[2]+#9+b+#9+Copy(s,5,255));
        SendMessage(Symb,lb_AddString,0,longint(@a));
      end;
  SendMessage(Symb,wm_SetRedraw,1,0);
end;

function DodajSymb(Okno:HWnd;zmiana:boolean):boolean;
var
  Symb:HWnd;
  bitnr:byte;
  l,adr,j:word;
  b:integer;
  kol:PStrCollection;
  nap:string[44];
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 zmiana=false then
  begin
    buforzn1[0]:=#0; buforzn2[0]:=#0; buforzn3[0]:=#0;
    if l=3 then
      b:=PokazDialog('NOWYBIT',@FunSymBit) else
      b:=PokazDialog('NOWYSYM',@FunSymbol);
  end
    else if l=3 then
      b:=PokazDialog('ZMIENBIT',@FunSymBit) else
      b:=PokazDialog('ZMIENSYM',@FunSymbol);
  DodajSymb:=true;
  if b<>1 then Exit;
  if (wynik='') or (wynik1='') then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(64),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if (Pos(' ',wynik)>0) or (Pos(',',wynik)>0) or (Pos(':',wynik)>0) then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(5),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if (l=3) and (wynik2='') then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(65),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  adr:=HEXtoW(wynik1);
  if codeconv<>0 then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(1),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if ((l=2) or (l=3)) and (adr>$FF) then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(8),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if l=3 then
  begin
    bitnr:=HEXtoB(wynik2);
    if (codeconv<>0) or ((codeconv=0) and (bitnr>7)) then
    begin
      MessageBeep(mb_IconHand);
      BWCCMessageBox(0,Napis1(65),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
      Exit;
    end;
    StrPCopy(buforzn1,BtoHEX(bitnr)+BtoHEX(adr)+wynik);
  end
  else StrPCopy(buforzn1,WtoHEX(adr)+wynik);
  DodajSymb:=false;
  if zmiana then Exit;
  kol^.Insert(StrNew(buforzn1));
  OdnowSymb(Okno);
  SetFocus(Symb);
  j:=SendMessage(Symb,lb_GetCaretIndex,0,0);
  SendMessage(Symb,lb_SetCurSel,j,0);
  OdrysujOkna(6); {Symb}
  if l=0 then
  begin
    OdrysujOkna(0); {Instr}
    OdrysujOkna(8); {Brk}
  end;
end;

procedure UsunSymb(Okno:HWnd);
var
  Symb:HWnd;
  l,j:word;
  kol:PStrCollection;
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_DeleteString,j,0);
  kol^.AtDelete(j);
  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 ZmienSymb(Okno:HWnd);
var
  Symb:HWnd;