dbgzmtyp.pas

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

function FunFontSize(Dialog:HWnd;Kod_meldunku,WParam:Word;LParam:Longint):Bool;
var
  R:TRect;
  Bufor:array[0..40] of char;
  info:PCzcionkaInfo;
  czcionki:PStrCollection;
  b:integer;
begin
  FunFontSize:=true;
  case Kod_meldunku of
    wm_InitDialog: begin
                     GetWindowRect(Dialog,R);
                     MoveWindow(Dialog,
                      (GetSystemMetrics(SM_CXSCREEN)-R.right+R.left) div 2,
                      (GetSystemMetrics(SM_CYSCREEN)-R.bottom+R.top) div 2,
                      R.right-R.left,R.bottom-R.top,false);
                     info:=PCzcionkaInfo(LParam);
                     czcionki:=info^.fonts;
                     for b:=0 to czcionki^.Count-1 do
                       SendMessage(GetDlgItem(Dialog,100),CB_ADDSTRING,0,longint(czcionki^.At(b)));
                     if info^.numer=-1 then
                       SendMessage(GetDlgItem(Dialog,100),CB_SETCURSEL,0,0) else
                       SendMessage(GetDlgItem(Dialog,100),CB_SETCURSEL,info^.numer,0);
                     if info^.bold then
                       CheckDlgButton(Dialog,102,1) else
                       CheckDlgButton(Dialog,102,0);
                     SetDlgItemInt(Dialog,101,info^.wielk,false);
                   end;
    wm_Command: case wParam of
                  1: begin
                       GetDlgItemText(Dialog,100,Bufor,40);
                       wynik:=StrPas(Bufor);
                       GetDlgItemText(Dialog,101,Bufor,10);
                       wynik1:=StrPas(Bufor);
                       if IsDlgButtonChecked(Dialog,102)=0 then wynik2:='N' else wynik2:='B';
                       EndDialog(Dialog,1);
                     end;
                  2: EndDialog(Dialog,2);
                end;
  else FunFontSize:=false;
  end;
end;

function BINtoW(co:string):word;
var
  x:word;
  n:byte;
begin
  x:=0; codeconv:=0;
  for n:=1 to Length(co) do
    case co[n] of
      '0': x:=x shl 1;
      '1': x:=(x shl 1) or 1;
      else begin
             codeconv:=-1;
             BINtoW:=x;
             Exit;
           end;
    end;
  BINtoW:=x;
end;

function WtoBIN(co:word):string;
var
  txt:string[16];
  n:byte;
begin
  txt:='0000000000000000';
  for n:=16 downto 1 do
  begin
    if (co and 1)=1 then txt[n]:='1';
    co:=co shr 1;
  end;
  WtoBIN:=txt;
end;

function BtoHEX0(co:byte):String4;
const Hx:array[0..15] of char='0123456789ABCDEF';
var tmp:String4;
begin
  tmp:='000';
  tmp[2]:=Hx[co shr 4];
  tmp[3]:=Hx[co and 15];
  if tmp[2] IN ['0'..'9'] then Delete(tmp,1,1);
  BtoHEX0:=tmp;
end;

function BtoHEX(co:byte):String2;
const Hx:array[0..15] of char='0123456789ABCDEF';
begin
  BtoHEX:='00';
  BtoHEX[1]:=Hx[co shr 4];
  BtoHEX[2]:=Hx[co and 15];
end;

function WtoHEX(co:word):String4;
begin
  WtoHEX:=BtoHEX(Hi(co))+BtoHEX(Lo(co));
end;

function HEXtoB(co:string):byte;
var t:byte;
begin
  Val('$'+co,t,codeconv);
  HEXtoB:=t;
end;

function HEXtoW(co:string):word;
var t:word;
begin
  Val('$'+co,t,codeconv);
  HEXtoW:=t;
end;

function LoCaseStr(co:string):string;
var
  i:byte;
  tmp:string;
begin
  tmp:=co;
  if Length(tmp)>0 then
    for i:=1 to Length(tmp) do
    if tmp[i] IN ['A'..'Z'] then tmp[i]:=char(byte(tmp[i])+32);
  LoCaseStr:=tmp;
end;

function UpCaseStr(co:string):string;
var
  i:byte;
  tmp:string;
begin
  tmp:=co;
  if Length(tmp)>0 then
    for i:=1 to Length(tmp) do tmp[i]:=UpCase(tmp[i]);
  UpCaseStr:=tmp;
end;

function StrFunI(x:integer):string;
var a:string;
begin
  Str(x,a);
  StrFunI:=a;
end;

function StrFunW(x:word):string;
var a:string;
begin
  Str(x,a);
  StrFunW:=a;
end;

function ValFunI(txt:string):integer;
var i:integer;
begin
  Val(txt,i,codeconv);
  ValFunI:=i;
end;

procedure AktualizujWtyczki(Okno:HWnd);
var n:byte;
  a:TFarProc;
begin
  if IleWtyczek=0 then Exit;
  for n:=0 to IleWtyczek-1 do
  if Wtyczki[n].s then
  begin
    a:=GetProcAddress(Wtyczki[n].h,'UPDATE');
    TypProcUpdate(a);
  end;
end;

function Napis1(nr:word):PChar;
begin
  buforzn1[0]:=#0;
  if jezykpl then
    LoadString(hInstance,nr,buforzn1,63) else
    LoadString(hInstance,nr+5000,buforzn1,63);
  if buforzn1[0]=#0 then Napis1:=nil else Napis1:=@buforzn1;
end;

function Napis2(nr:word):PChar;
begin
  buforzn2[0]:=#0;
  if jezykpl then
    LoadString(hInstance,nr,buforzn2,63) else
    LoadString(hInstance,nr+5000,buforzn2,63);
  if buforzn2[0]=#0 then Napis2:=nil else Napis2:=@buforzn2;
end;

function Dial(nazwa:Pchar):Pchar;
begin
  buford[0]:='E';
  StrCopy(buford+1,nazwa);
  if jezykpl then Dial:=buford+1 else Dial:=buford;
end;

function Fun_Wszyscy(Okno:HWnd;LParam:longint):Bool;  EXPORT;
var dane:record
      ty,km,wp:word;
      lp:longint;
    end;
begin
  Fun_Wszyscy:=true;
  if GetParent(Okno)<>Klient then Exit;
  Move(pointer(LParam)^,dane,SizeOf(dane));
  with dane do
    if ty=255 then SendMessage(Okno,km,wp,lp) else
      if GetWindowWord(Okno,0)=ty then SendMessage(Okno,km,wp,lp);
end;

procedure DoWszystkich(typ,Kod_meldunku,wParam:word;LParam:longint);
var
  a:TFarProc;
  dane:record
    ty,km,wp:word;
    lp:longint;
  end;
begin
  dane.ty:=typ;
  dane.km:=Kod_meldunku;
  dane.wp:=wParam;
  dane.lp:=LParam;
  a:=MakeProcInstance(@Fun_Wszyscy,hInstance);
  EnumChildWindows(Klient,a,longint(@dane));
  FreeProcInstance(a);
end;

procedure OdrysujWszystkie;
begin
  DoWszystkich(255,wm_Command,us_OdnowWidok,0);
end;

procedure OdrysujOkna(typ:word);
begin
  DoWszystkich(typ,wm_Command,us_OdnowWidok,0);
end;

procedure OdrysujCoTrzeba;
begin
  DoWszystkich(255,wm_Command,us_OdnowCoTrzeba,0);
end;

function ZnajdzSymb(gdzie:PStrCollection;txtpocz:String4):integer;
var
  l,r,n,i,max:integer;
  t:array[0..4] of char;
begin
  ZnajdzSymb:=-1;
  max:=gdzie^.Count-1;
  if max=-1 then Exit;
  l:=0; r:=max;
  StrPCopy(t,txtpocz);
  repeat
    n:=(l+r) div 2;
    i:=StrLComp(t,gdzie^.At(n),4);
    if i=0 then begin ZnajdzSymb:=n; Exit; end
    else
    begin
      if l=r then begin ZnajdzSymb:=-1; Exit; end;
      if i<0 then
      begin
        if n=0 then begin ZnajdzSymb:=-1; Exit; end;
        r:=n-1;
        if r<l then r:=l;
      end
        else
      begin
        if n=max then begin ZnajdzSymb:=-1; Exit; end;
        l:=n+1;
        if l>r then l:=r;
      end;
    end;
  until false;
end;

function Fun_ListaOkien(Okno:HWnd;LParam:longint):Bool;  EXPORT;
var p:PCollection;
begin
  Fun_ListaOkien:=true;
  if GetParent(Okno)<>Klient then Exit;
  p:=pointer(LParam);
  p^.Insert(pointer(Okno));
end;

procedure ListaOkien;
var
  a:TFarProc;
  Lista:PCollection;
  m1,m2:HMenu;
  numr,wyn,ty:word;
  blad:boolean;
  stekst:array[0..40] of char;
begin
  New(Lista,Init(20,20));
  a:=MakeProcInstance(@Fun_ListaOkien,hInstance);
  EnumChildWindows(Klient,a,longint(Lista));
  FreeProcInstance(a);
  m1:=GetSubMenu(MenuGlownePL,8);
  m2:=GetSubMenu(MenuGlowneEN,8);
  DeleteMenu(m1,2,MF_BYCOMMAND);
  DeleteMenu(m2,2,MF_BYCOMMAND);
  numr:=us_OknoNr0;
  blad:=true;
  repeat
    DeleteMenu(m1,numr,MF_BYCOMMAND);
    blad:=DeleteMenu(m2,numr,MF_BYCOMMAND);
    Inc(numr);
  until not blad;
  if Lista^.Count=0 then
  begin
    AppendMenu(m1,MF_GRAYED or MF_STRING,2,'<brak>');
    AppendMenu(m2,MF_GRAYED or MF_STRING,2,'<none>');
    Lista^.DeleteAll;
    Dispose(Lista,Done);
    Exit;
  end;
  for numr:=0 to Lista^.Count-1 do
  begin
    wyn:=word(Lista^.At(numr));
    ty:=GetWindowWord(wyn,0);
    StrPCopy(stekst,StrFunW(numr)+'  ');
    StrCat(stekst,Napis1(ty+26));
    AppendMenu(m1,MF_STRING,numr+us_OknoNr0,stekst);
    AppendMenu(m2,MF_STRING,numr+us_OknoNr0,stekst);
    SetWindowText(LoWord(wyn),stekst);
  end;
  Lista^.DeleteAll;
  Dispose(Lista,Done);
end;

function PokazDialog(nazwa:Pchar;funkcja:TFarProc):integer;
var
  a:array[0..15] of char;
  c:integer;
begin
  a[0]:='E';
  StrCopy(a+1,nazwa);
  if jezykpl then
    c:=DialogBox(hInstance,a+1,OknoGlowne,funkcja) else
    c:=DialogBox(hInstance,a,OknoGlowne,funkcja);
  PokazDialog:=c;
end;

function PokazDialogParam(nazwa:Pchar;funkcja:TFarProc;param:longint):integer;
var
  a:array[0..15] of char;
  c:integer;
begin
  a[0]:='E';
  StrCopy(a+1,nazwa);
  if jezykpl then
    c:=DialogBoxParam(hInstance,a+1,OknoGlowne,funkcja,param) else
    c:=DialogBoxParam(hInstance,a,OknoGlowne,funkcja,param);
  PokazDialogParam:=c;
end;

function DialogSzer(x:word):word;
begin
  DialogSzer:=(x*LoWord(GetDialogBaseUnits)) div 4;
end;

function DialogWys(y:word):word;
begin
  DialogWys:=(y*HiWord(GetDialogBaseUnits)) div 8;
end;

function FunWyliczCzcionki(lf:PLogFont;tm:PTextMetric;typ:integer;LParam:longint):Bool;  EXPORT;
begin
  if ((lf^.lfPitchAndFamily and FIXED_PITCH)=FIXED_PITCH) and (StrLen(lf^.lfFaceName)>2) then
    PStrCollection(LParam)^.Insert(StrNew(lf^.lfFaceName));
  FunWyliczCzcionki:=true;
end;

procedure WyliczCzcionkiF(gdzie:PStrCollection);
var DC:HDC;
begin
  DC:=GetDC(OknoGlowne);
  EnumFonts(DC,nil,@FunWyliczCzcionki,gdzie);
  ReleaseDC(OknoGlowne,DC);
end;

end.