Quelltext /~heha/hs/lptdac.zip/LDDLG2.PAS

{$K+,W-,X+}
unit lddlg2;

interface
{$C Moveable DemandLoad Discardable}
uses WinProcs,WinTypes,Strings,Win31,ldh;
{$R lptdac2}

function Dialog(WndParent:HWnd):Integer;
function ErrorMsgBox(Wnd:HWnd;StringId:Word):Integer;

implementation

var
 Sb: SbRec;
 O: ORec;
 Wnd: HWnd;	{Globales Handle - besser im Zugriff}

function ErrorMsgBox(Wnd:HWnd;StringId:Word):Integer;
 var
  S: TS255;
 begin
  LoadString(Seg(HInstance),StringId,S,sizeof(S));
  ErrorMsgBox:=MessageBox(Wnd,S,AppName,MB_OK or MB_IconExclamation);
 end;

function ShowWindows(FirstID:Word;Count:Integer; NewState:Bool):Integer;
{schaltet Fenster sichtbar oder unsichtbar.
 Bei Count>0 auf Basis der Fenster-Reihenfolge,
 bei Count<0 auf Basis aufeinanderfolgender ID's}
 var
  ShowCmd: Integer absolute NewState;
  Window: HWnd absolute FirstID;
 begin
  if NewState then ShowCmd:=SW_Show {else ShowCmd:=SW_Hide};
  if Count>=0 then begin
   Window:=GetDlgItem(Wnd,FirstID);
   while Count>0 do begin
    ShowWindow(Window,ShowCmd);
    Window:=GetWindow(Window,GW_HWndNext);
    Dec(Count);
   end;
  end else begin
   Count:=-Count;
   while Count>0 do begin
    ShowWindow(GetDlgItem(Wnd,FirstID),ShowCmd);
    Inc(FirstID);
    Dec(Count);
   end;
  end;
 end;

procedure SetACheck(FirstID,LastID,NewID:Word);
 begin
  CheckRadioButton(Wnd,firstID,lastID,NewID);
{Edit-Fenster und Radio-Button wechselweise aktivieren}
  EnableWindow(GetDlgItem(Wnd,lastID+1),NewID=lastID);	{Edit-Fenster}
  EnableWindow(GetDlgItem(Wnd,lastID),NewID<>lastID);	{Radio-Button}
 end;

function SetTextCheck(FirstID,LastID:Word; Txt:PChar):word;
 var
  Buf:array[0..7]of char;
 begin
  SetDlgItemText(Wnd,lastID+1,Txt);	{Text erst einmal setzen}
  SendDlgItemMessage(Wnd,lastID+1,EM_SetSel,0,$ffff0000); {ganz markieren}
  while firstID<lastID do begin
   if IsWindowEnabled(GetDlgItem(Wnd,FirstID))
   and (GetDlgItemText(Wnd,firstID,Buf,sizeof(Buf))>0)
   and (lStrCmpi(Buf,Txt)=0) then break;{richtiges Schaltfeld gefunden}
   Inc(firstID);
  end;
  SetACheck(FirstID,LastID,FirstID);
 end;

const
 EN_Up=$0800+VK_Up;
 EN_Down=$0800+VK_Down;
 EN_Space=$0800+VK_Space;
{Diese Meldungen funktionieren wie alle anderen EN_xxxx-Benachrichtigungen}

procedure SetNewCheck(firstID,lastID,NewID,Notify:Word);
 var
  AWnd: HWnd;
 label
  l1;
 begin
  if (NewID=lastID+1) then begin
   case Notify of
    EN_Up: begin
{GetNextDlgGroupItem(Wnd,GetDlgItem(Wnd,FirstID),true)}
     NewID:=lastID;	{von hinten anfangen mit Suchen}
     while NewID>=FirstID do begin
      AWnd:=GetDlgItem(Wnd,NewID);
      if (AWnd<>0) and IsWindowVisible(AWnd) and IsWindowEnabled(AWnd)
      then goto l1;
      Dec(NewID);
     end;
    end;

    EN_Down: begin
{GetNextDlgGroupItem(Wnd,GetDlgItem(Wnd,FirstID),false)}
     NewID:=FirstID;	{von vorn anfangen mit Suchen}
     while NewID<=LastID do begin
      AWnd:=GetDlgItem(Wnd,NewID);
      if (AWnd<>0) and IsWindowVisible(AWnd) and IsWindowEnabled(AWnd)
      then goto l1;
      Inc(NewID);
     end;
    end;

   end;
   exit;		{Keine geeignete Nachricht gefunden - raus!}
{Hier geht es weiter, wenn VK_Down bzw. VK_Up wirkt}
l1: SetFocus(GetDlgItem(Wnd,NewID));	{Neuen Button hervorheben}
  end;

  SetACheck(firstID,lastID,NewID);
{Bei angeklicktem letzten Button Edit-Fenster aktivieren}
  if (NewID=lastID) and (Notify=BN_Clicked)
  then SetFocus(GetDlgItem(Wnd,lastID+1));
 end;

function GetTextCheck(firstID,lastID:Word; Txt:PChar; TxtLen:Word):
 Word;
 begin
  while firstID<lastID do begin
   if IsDlgButtonChecked(Wnd,firstID)=1 then break;
   Inc(firstID);
  end;
  if firstID=lastID then Inc(firstID);	{Beim letzten Knopf ein Item dahinter}
  GetDlgItemText(Wnd,firstID,Txt,TxtLen);
  GetTextCheck:=FirstID;		{Gefundene ID zurckliefern}
 end;

function HelpDlgProc(Window:HWnd;Msg,wParam:Word;lParam:LongInt):Bool;
 export;
 begin
  HelpDlgProc:=false;
  case Msg of
   WM_Command: case wParam of
    IDOK,IDCancel: EndDialog(Window,wParam);
   end;
  end;
 end;

function EnableEmu:Integer;
 begin
  ShowWindows(270,24,Sb.Feat and 1 <>0);
 end;

function OnePort:Bool;
 begin
  OnePort:= (O.Dev>1) and not
    ((O.Dev=3) and (O.Feat and $100 =0) and (O.Feat and $20 <>0));
 end;

function TwoPorts:Bool;
 begin
  TwoPorts:= (O.Dev in [2,4]) and (O.Feat and $04 <>0);
 end;

function EnableFeatures:Integer;
{Portadressen neu anzeigen oder verbergen}
 var
  S:TS31;
  NewState: Bool;
 begin
  NewState:=OnePort;
  ShowWindows(201,3,NewState and (O.Dev<>4));	{3 Knpfe}
  ShowWindows(208,2,NewState);	{Knopf und Eingabefeld}
  NewState:=TwoPorts;
  ShowWindows(882,1,NewState);	{Label "L"}
  ShowWindows(883,1,NewState);	{Label "R"}
  ShowWindows(211,3,NewState and (O.Dev<>4));	{3 Knpfe}
  ShowWindows(218,2,NewState);	{Knopf und Eingabefeld}
  if O.Dev=4 then begin		{Eingabefelder aktivieren}
   SetACheck(201,208,208);
   GetDlgItemText(Wnd,209,S,sizeof(S));
   if S[0]='L' then SetDlgItemInt(Wnd,209,300,false);	{Trick 17}
   SetACheck(211,218,218);
   GetDlgItemText(Wnd,219,S,sizeof(S));
   if S[0]='L' then SetDlgItemInt(Wnd,219,302,false);	{Trick 17b}
  end;
 end;

{ Tabelle der ID's und Belegungen:
Feat	ID	Text		Speaker	LPTDAC	SO1/SOD	16bit	User
$0001	311	Extended 10 bit	-	X	X	-	(literal)
$0002	312	Extended 12 bit	-	X	-/X	-	-
$0004	313	Stereo		-	X	-(1)	X	X
$0008	314	signed		-	X	X	X	X
$0010	315	2 Ch. Mix	-("1")	X	X	X	X
$0020	316	Auto Detect	-	-	X/-	-	-
$0040	317	Rev. ByteOrder	-	-	-	X	-
$0080	318	16bit I/O	-	-	-	X	-
$0100	319	SOD(TM)		-	-	X	-	-
$0200	(320)	SkipDetect	-	X	X	X	X
$0400	(321)	ContMgr		X	X	X	X	X
$0800	(322)	NeedUpdate	1	0	0	0	X
(1): Bit wird intern als gesetzt interpretiert}
function EnableNewDevice:Integer;
{Portadressen, Features und Icons neu anzeigen oder verstecken}
 begin
  ShowWindows(311,-9,false);
  case O.Dev of
   2: begin
    ShowWindows(311,-5,true);
   end;
   3: begin
    ShowWindows(311,-1-Word(O.Feat and $100<>0),true);
    ShowWindows(314,-2-Word(O.Feat and $100 =0),true);
    ShowWindows(319,1,true);
   end;
   4: begin
    ShowWindows(313,-3,true);
    ShowWindows(317,-2,true);
   end;
  end;
  EnableFeatures;		{Knpfe freischalten}
  ShowWindows(884,1,O.Dev=1);	{Bildsymbole}
  ShowWindows(885,1,O.Dev in [2,3]); {besser in BP7}
  ShowWindows(886,1,O.Dev in [2,4]); {als ein OR}
 end;

function PrfWrite(Key,Format:PChar; Item:LongInt): Bool;
 var
  Buf: TS31;
 begin
  if Format<>nil then begin
   wvsprintf(Buf,Format,Item);
   WritePrivateProfileString(AppName,Key,Buf,Profile);	{fest in SYSTEM.INI}
  end else begin
   WritePrivateProfileString(AppName,Key,nil,Profile);	{lschen!}
  end;
 end;

function GetLptAdr(S:PChar; var W:Word):Word;
{liefert Portadresse und Fehlercode der Auswertung}
 var
  LptNum,EC:Integer;
  Buf: TS7;
 begin
  GetLptAdr:=0;			{Optimistisch: Kein Fehler}
  if (O.Dev<>4) and (S[0]='L') and (S[1]='P') and (S[2]='T') then begin
   Val(S[3],LptNum,EC);		{welche Zahl steht dahinter?}
   if (EC=0) and (LptNum>=1) and (LptNum<=4) then begin  {Zahl gltig?}
    W:=LptPtr^[LptNum];
    if W=0 then GetLptAdr:=3;	{LPT ist nicht durch Hardware belegt}
   end else GetLptAdr:=3;	{Ungltige LPT-Angabe (z.B. LPT5)}
   exit;			{sonst fehlerfreie LPT-Angabe}
  end;
  Buf[0]:='$';
  lStrCpy(@Buf[1],S);		{Hex-String wandeln ber Zwischenpuffer}
  Val(Buf,W,EC);		{bei EC<>0 wird W=0}
  if EC<>0 then GetLptAdr:=3;	{Hex-Zahl (Portangabe) falsch}
  if W=0 then GetLptAdr:=3;	{Portangabe Null ist ungltig}
 end;

var
 DefEditProc: TFarProc;

{Die subklassifizierten EDIT-Elemente fangen 3 Tasten ab}
function EditProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):
  LongInt; export;
 begin
  if (Msg=WM_KeyDown)
  and ((wParam=VK_Up) or (wParam=VK_Down))
  or (Msg=WM_Char)
  and (wParam=VK_Space)
  then EditProc:=SendMessage(GetParent(Wnd),WM_Command,
    GetDlgCtrlID(Wnd),MakeLong(Wnd,$0800+wParam))
  else EditProc:=CallWindowProc(DefEditProc,Wnd,Msg,wParam,lParam);
 end;

function ConfigDlgProc(Window:HWnd;msg,wParam:Word;lParam:LongInt):Bool;export;
 var
  buf: TS7;	{Mini-Puffer fr GetProfileString...}
  PortStr: TS7;	{Port-Adresse LPTn oder in hex}
  Port2Str:TS7;	{Port-Adresse LPTn oder in hex}
  SP: PChar;
  Trash: Word;	{enthlt mal kurz die LPTDAC-Portadresse}
  id: Integer;
  EC,EW: Word;
 const
  SubclassID: array[0..6]of Word=(209,219,279,289,299,259,269);

 begin
  ConfigDlgProc:=false;	{Normalerweise: Botschaft NICHT verarbeitet}
  case msg of
   WM_InitDialog: begin
    Wnd:=Window;
    DefEditProc:=TFarProc(GetWindowLong(GetDlgItem(Wnd,209),GWL_WndProc));
    for id:=0 to 6 do SetWindowLong(GetDlgItem(Wnd,SubClassID[id]),
      GWL_WndProc,LongInt(@EditProc));
{LPTs freischalten}
    for id:=1 to 3 do begin
     if LptPtr^[id]=0 then begin
      EnableWindow(GetDlgItem(Wnd,id+200),false);
      EnableWindow(GetDlgItem(Wnd,id+210),false);
     end;
    end;
{Profildatei auslesen}
    O.Dev:=GetPrivateProfileInt(AppName,StODev,1,Profile);
    CheckDlgButton(Wnd,300+O.Dev,1);

    GetPrivateProfileString(AppName,StPort,'LPT1',
     PortStr,sizeof(PortStr),Profile);
    SetTextCheck(201,208,PortStr);

    GetPrivateProfileString(AppName,StPort2,'LPT2',
     Port2Str,sizeof(Port2Str),Profile);
    SetTextCheck(211,218,Port2Str);

    O.Feat:=GetPrivateProfileInt(AppName,StFeat,0,Profile);
    Trash:=1;		{Bitmaske}
    for id:=311 to 319 do begin
     if O.Feat and Trash <>0 then CheckDlgButton(Wnd,id,1);
     Trash:=Trash shl 1;
    end;
    EnableNewDevice;

    GetPrivateProfileString(AppName,StSbPort,'220',
     Buf,sizeof(Buf),Profile);
    SetTextCheck(271,278,Buf);

    GetPrivateProfileString(AppName,StSbIrq,'5',
     Buf,sizeof(Buf),Profile);
    SetTextCheck(281,288,Buf);

    GetPrivateProfileString(AppName,StSbDma,'1',
     Buf,sizeof(Buf),Profile);
    SetTextCheck(291,298,Buf);

    GetPrivateProfileString(AppName,StSbHiDma,'5',
     Buf,sizeof(Buf),Profile);
    SetDlgItemText(Wnd,259,Buf);

    GetPrivateProfileString(AppName,StSbVer,'2.0',
     Buf,sizeof(Buf),Profile);
    SetTextCheck(261,268,Buf);

    Sb.Feat:=GetPrivateProfileInt(AppName,StSbFeat,1,Profile);
    Trash:=1;		{Bitmaske}
    for id:=230 to 232 do begin
     if Sb.Feat and Trash <>0 then CheckDlgButton(Wnd,id,1);
     Trash:=Trash shl 1;
    end;
    EnableEmu;

    EnableWindow(GetDlgItem(Wnd,100),PtrRec(ldEntry).Sel<>0);

    ConfigDlgProc:=true;
   end;

   WM_COMMAND: begin
    case wParam of
     IDOK: begin
      EC:=0;	{kein Fehler!}
{Buttons ablesen}
      repeat
       if OnePort then begin
	EW:=GetTextCheck(201,208,PortStr,sizeof(PortStr));
	EC:=GetLptAdr(PortStr,O.Port);
	if EC<>0 then break;
       end;

       if TwoPorts then begin
	EW:=GetTextCheck(211,218,Port2Str,sizeof(Port2Str));
	EC:=GetLptAdr(Port2Str,O.Port2);
	if EC<>0 then break;
       end;

       if Sb.Feat and 1 <>0 then begin
	EW:=GetTextCheck(271,278,@Buf[1],sizeof(Buf)-1);
	Buf[0]:='$';
	Val(Buf,Sb.Port,id);
	if id<>0 then EC:=3;

	EW:=GetTextCheck(281,288,Buf,sizeof(Buf));
	Val(Buf,Sb.Irq,id);
	if id<>0 then EC:=3;

	EW:=GetTextCheck(291,298,Buf,sizeof(Buf));
	Val(Buf,Sb.Dma,id);
	if (id<>0) or (Sb.Dma>=16) then EC:=3;

	EW:=259;
	Trash:=GetDlgItemInt(Wnd,259,PBool(@id),false);
	Sb.Dma:=Sb.Dma or (Trash shl 4);
	if (id=0) or (Trash>=16) then EC:=3;

	EW:=GetTextCheck(261,268,Buf,sizeof(Buf));
	SP:=StrScan(Buf,'.'); Sb.VerLo:=0;
	if SP<>nil then begin
	 SP^:=#0;
	 Inc(SP);
	 Val(SP,Sb.VerLo,id);
	 if id<>0 then EC:=3;
	end;
	Val(Buf,Sb.VerHi,id);
	if id<>0 then EC:=3;
       end;

      until true;

{Werte prfen}
      if EC<>0 then
      begin
       ErrorMsgBox(Wnd,EC);		{Fehler melden}
       SetFocus(GetDlgItem(Wnd,EW));	{fehlerhaftes Element fokussieren}
       SendDlgItemMessage(Wnd,EW,EM_SetSel,0,$ffff0000); {ganz markieren}
      end else begin

{Werte eintragen, drei Profil-Eintrge werden bedingt gesetzt u. nie gelscht}
       PrfWrite(StODev,StDec,O.Dev);
       if O.Dev>1 then PrfWrite(StFeat,StDec,O.Feat);
       if OnePort then PrfWrite(StPort,StStr,LongInt(@PortStr));
       if TwoPorts then PrfWrite(StPort2,StStr,LongInt(@Port2Str));
{Die SoundBlaster-Emulationswerte werden bedingt gesetzt und nie gelscht}
       if Sb.Feat and 1 <>0 then begin
	PrfWrite(StSbPort,'%X',Sb.Port);
	PrfWrite(StSbIrq,StDec,Sb.Irq);
	PrfWrite(StSbDma,StDec,Sb.Dma and $F);
	PrfWrite(StSbHiDma,StDec,Sb.Dma shr 4);
	PrfWrite(StSbVer,'%d.%d',MakeLong(Sb.VerHi,Sb.VerLo));
       end;
       PrfWrite(StSbFeat,StDec,Sb.Feat);
       Trash:=2;		{Reboot-Request, wenn kein VxD da ist}
{VxD informieren}
       if PtrRec(ldEntry).Sel<>0 then asm	{386+ vorhanden!}
	mov	al,[O.Dev]
	mov	bx,ldDeviceID
	mov	cx,[O.Feat]
	db $66
	mov	dx,[O.Port]	{beide Portadressen in EDX laden}
	mov	ah,4		{Ausgabegert setzen}
	call	[ldEntry]
	mov	byte ptr [Trash],al	{Exitcode setzen (meist AL=1: OK)}

	mov	al,[Sb.Feat]
	mov	bx,ldDeviceID
	mov	cx,[Sb.Ver]
	db $66
	mov	dx,[Sb.Port]	{Portbasis, IRQ und DMA in EDX laden}
	mov	ah,2		{SB-Emulation setzen}
	call	[ldEntry]
	cmp	al,1
	jz	@@2
	mov	byte ptr [Trash],al	{Fehlermeldung AL=0 oder Reboot AL=2}
@@2:   end;
       EndDialog(Wnd,Trash);
      end;
     end;

     IDCancel: begin
      EndDialog(Wnd,0);
     end;

     9: DialogBox(hInstance,MakeIntResource(2),Wnd,@HelpDlgProc);
     100: ErrorMsgBox(Wnd,7);

     301..304: begin	{Radio-Button fr Ausgabe-Device O.Dev}
      O.Dev:=wParam-300;
      EnableNewDevice;
     end;

     311..319: begin			{O.Feat-Checkboxen}
      Trash:=1 shl (wParam-311);
      if IsDlgButtonChecked(Wnd,wParam)=1 then O.Feat:=O.Feat or Trash
      else O.Feat:=O.Feat and not Trash;
      case wParam of
       311: begin
	CheckDlgButton(Wnd,312,0);	{Nur eines der beiden ankreuzen!}
	O.Feat:=O.Feat and not 2;
       end;
       312: begin
	CheckDlgButton(Wnd,311,0);	{Nur eines der beiden ankreuzen!}
	O.Feat:=O.Feat and not 1;
       end;
       313,				{Stereo oder}
       316: EnableFeatures;		{Auto-Detect: LPT-Angaben wechseln}
       319: begin			{SOD statt SO1}
	ShowWindows(316,1,O.Feat and $100 =0);	{Auto-Detect}
	ShowWindows(312,1,O.Feat and $100<>0);	{Ext12bit}
	EnableFeatures;			{bei SOD ggf. Portadressen schalten!}
       end;
      end;
     end;

     230..232: begin			{SB.Feat-Checkboxen}
      Trash:=1 shl (wParam-230);
      if IsDlgButtonChecked(Wnd,wParam)=1 then Sb.Feat:=Sb.Feat or Trash
      else Sb.Feat:=Sb.Feat and not Trash;
      if wParam=230 then EnableEmu;
      if (wParam=231) and (Sb.Feat and 2 <>0)
      then SetFocus(GetDlgItem(Wnd,259));
     end;

     201..209: SetNewCheck(201,208,wParam,LongRec(lParam).Hi);
     211..219: SetNewCheck(211,218,wParam,LongRec(lParam).Hi);
     271..279: SetNewCheck(271,278,wParam,LongRec(lParam).Hi);
     281..289: SetNewCheck(281,288,wParam,LongRec(lParam).Hi);
     291..299: SetNewCheck(291,298,wParam,LongRec(lParam).Hi);
     259: begin
      if LongRec(lParam).Hi=EN_Space then begin	{CheckBox daneben markieren}
       CheckDlgButton(Wnd,231,1-IsDlgButtonChecked(Wnd,231));
       SendMessage(Wnd,WM_Command,231,0);
      end;
     end;
     261..269: SetNewCheck(261,268,wParam,LongRec(lParam).Hi);
    end; {case wParam}
   end; {WM_Command}
  end; {case Msg}
 end;

function Dialog(WndParent:hWnd):integer;
 begin
  Dialog:=DialogBox(Seg(hInstance),MakeIntResource(1),WndParent,@ConfigDlgProc);
 end;

end.
Vorgefundene Kodierung: UTF-80