{$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 zurückliefern}
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 Knöpfe}
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 Knöpfe}
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; {Knöpfe 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); {löschen!}
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 gültig?}
W:=LptPtr^[LptNum];
if W=0 then GetLptAdr:=3; {LPT ist nicht durch Hardware belegt}
end else GetLptAdr:=3; {Ungültige 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 ungültig}
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 für GetProfileString...}
PortStr: TS7; {Port-Adresse LPTn oder in hex}
Port2Str:TS7; {Port-Adresse LPTn oder in hex}
SP: PChar;
Trash: Word; {enthält 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 prüfen}
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-Einträge werden bedingt gesetzt u. nie gelöscht}
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 gelöscht}
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 {Ausgabegerät 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 für 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.
| Detected encoding: OEM (CP437) | 1
|
|
|