unit wutils32;
interface
uses Windows,Messages,ShellApi;
const
StdMBoxTitle: PChar=nil;
MB_Sound = $0080;
File_Share_Delete=4;
function vMBox(WndParent:HWnd; ID,style:Word; var p):Integer; stdcall;
function MBox0(WndParent:HWnd; ID,style:Word):Integer; cdecl;
function MBox1(WndParent:HWnd; ID,style:Word; S1:PChar):Integer; cdecl;
function MBox2(WndParent:HWnd; ID,style:Word; S1,S2:PChar):Integer; cdecl;
function MBox3(WndParent:HWnd; ID,style:Word; S1,S2,S3:PChar):Integer; cdecl;
function MBox4(WndParent:HWnd; ID,style:Word; S1,S2,S3,S4:PChar):Integer; cdecl;
function MBox5(WndParent:HWnd; ID,style:Word; S1,S2,S3,S4,S5:PChar):Integer; cdecl;
function MBox6(WndParent:HWnd; ID,style:Word; S1,S2,S3,S4,S5,S6:PChar):Integer; cdecl;
function MBox7(WndParent:HWnd; ID,style:Word; S1,S2,S3,S4,S5,S6,S7:PChar):Integer; cdecl;
function MBox8(WndParent:HWnd; ID,style:Word; S1,S2,S3,S4,S5,S6,S7,S8:PChar):Integer; cdecl;
//Fehldefinitionen bzgl. Win16
function GetDlgItemInt(Wnd:HWnd;id:UInt;b:PBool;sign:Bool):UInt; stdcall;
function wvsprintf(s,t:PChar; var v):Integer; stdcall;
function wsprintf0(s,t:PChar):Integer; cdecl;
function wsprintf1(s,t,v1:PChar):Integer; cdecl;
function wsprintf2(s,t,v1,v2:PChar):Integer; cdecl;
function wsprintf3(s,t,v1,v2,v3:PChar):Integer; cdecl;
function wsprintf4(s,t,v1,v2,v3,v4:PChar):Integer; cdecl;
function wsprintf5(s,t,v1,v2,v3,v4,v5:PChar):Integer; cdecl;
function wsprintf6(s,t,v1,v2,v3,v4,v5,v6:PChar):Integer; cdecl;
function wsprintf7(s,t,v1,v2,v3,v4,v5,v6,v7:PChar):Integer; cdecl;
function wsprintf8(s,t,v1,v2,v3,v4,v5,v6,v7,v8:PChar):Integer; cdecl;
function GetWindowUInt(Wnd: HWnd; Index: Integer): UInt; stdcall;
function SetWindowUInt(Wnd: HWnd; Index: Integer; NewWord: UInt): UInt; stdcall;
function GetClassUInt(Wnd: HWnd; Index: Integer): UInt; stdcall;
function SetClassUInt(Wnd: HWnd; Index: Integer; NewWord: UInt): UInt; stdcall;
type
TS255=array[0..255] of Char;
TS127=array[0..127] of Char;
TS63=array[0..63] of Char;
TS31=array[0..31] of Char;
TS15=array[0..15] of Char;
TS7=array[0..7] of Char;
TS3=array[0..3] of Char;
function min(I1,I2:Integer):Integer; {Integer=LongInt}
function max(I1,I2:Integer):Integer;
function Bool2MenuCheck(x:Bool):UInt;
function IfThenElse(i:Boolean; t,e:Integer):Integer; {"?:"-Operator}
function IfThenElseP(i:Boolean; t,e:PChar):PChar; {"?:"-Operator}
type Bool2MenuGray=UInt;
procedure InitStruct(var s; slen:Integer);
procedure ShortYield;
type
LongRec=record
lo,hi:Word;
end;
WordRec=record
lo,hi:Byte;
end;
PPChar=^PChar;
type
TCompProc=function(s1,s2:PChar):Integer; stdcall;
function lstrchr(s:PChar; c:Char):PChar; //stdcall;
{Zeichen <c> im String <Str> suchen, Position liefern}
function lstrcmp1(s_short,s_long:PChar;CP:TCompProc):Integer;
{Anfang von <s_long> mit <s_short> vergleichen, entweder strcmpi oder strcmp}
function lstrstr(needle,heap:PChar;CP:TCompProc):PChar;
{einfache Suche von Nadel in Heuhaufen, entweder strcmpi oder strcmp}
{C-mige String-Umwandlung in darstellbares Format}
function EscapeStr(src:PChar; slen:UInt; dst:PChar; dlen:UInt):UInt;
function UnescapeStr(src, dst:PChar; dlen:UInt):UInt;
function GetFileNamePtr(S:PChar):PChar;
{liefert Zeiger hinter das letzte Auftreten von /\: oder Stringanfang}
function GetFileNameExt(S:PChar):PChar;
{liefert Zeiger AUF DEN PUNKT oder AUF DIE NULL, niemals NIL}
function GetRadioCheck(Wnd:HWnd; u,o:UInt):UInt;
function GetCheckboxGroup(Wnd:HWnd; u,o:UInt):UInt;
procedure SetCheckboxGroup(Wnd:HWnd; u,o,x:UInt);
function SendMessageP(Wnd:HWnd;Msg,wParam:UInt;lParam:Pointer):LongInt; stdcall;
function SendDlgItemMsgP(Dlg: HWnd; IDDlgItem: Integer; Msg, wParam: UInt;
lParam: Pointer): LongInt; stdcall;
function EnableDlgItem(Wnd:HWnd; idItem:UInt; Enable:Bool):Bool;
{Aktivieren bzw. Grausetzen eines Dialogelements.
Achtung - Gefahr: Noch keine Fokuskontrolle!}
procedure EnableDlgItemGroup(Wnd:HWnd; u,o:UInt; Enable:Bool);
{Aktivieren bzw. Grausetzen einer Reihe von Dialogfeldern.
Achtung: Ohne Fokuskontrolle!}
function ShowDlgItem(Wnd:HWnd; idItem:UInt; iShow:Integer):Bool;
procedure ShowDlgItemGroup(Wnd:HWnd; u,o:UInt; iShow:Integer);
{dito frs Anzeigen/Verstecken}
procedure SetEditFocus(HWndEdit: HWnd);
{fokussiert+markiert Editfenster}
procedure SortRect(var R:TRect);
{sortiert die Koordinaten in R so um,
da top/left links oben und bottom/right rechts unten ist}
function MoveRectIntoRect(var R:TRect; const R2:TRect): Bool;
{Dient zum Hineinholen von auerhalb liegenden Fenstern in den Desktop.}
procedure GetFullScreenRect(var R:TRect);
{liefert ideales R2 fr MoveRectIntoRect zur Ganz-Anzeige von Dialogen u..}
procedure MoveRectIntoFullScreen(var R:TRect);
{die logische Kombination beider o.g. Routinen}
function iitrafo(x,a,e,ta,te:Integer):Integer;
implementation
function vMBox(WndParent:HWnd; ID,style:Word; var p):Integer;
var
S,S2: array[0..255]of Char; {2 Puffer; leider so erforderlich}
SPH: PChar; {Zeiger auf Text und Titel}
I,K: Integer;
begin
I:=LoadString(HInstance,ID,S,sizeof(S)); {I=Anzahl der Zeichen insgesamt}
K:=lstrlen(S);
SPH:=StdMBoxTitle;
if I>K then SPH:=S+K+1;
wvsprintf(S2,S,P);
if style and MB_Sound <>0 then MessageBeep(style and $0070);
vMBox:=MessageBox(WndParent,S2,SPH,style and not MB_Sound);
end;
function MBox0; external;
function MBox1; external;
function MBox2; external;
function MBox3; external;
function MBox4; external;
function MBox5; external;
function MBox6; external;
function MBox7; external;
function MBox8; external;
{$L mbox32}
//function lstrchr; external 'msvcrt.dll' name 'strchr';
function GetDlgItemInt; external 'user32.dll' name 'GetDlgItemInt';
function wvsprintf; external 'user32.dll' name 'wvsprintfA';
function wsprintf0; external 'user32.dll' name 'wsprintfA';
function wsprintf1; external 'user32.dll' name 'wsprintfA';
function wsprintf2; external 'user32.dll' name 'wsprintfA';
function wsprintf3; external 'user32.dll' name 'wsprintfA';
function wsprintf4; external 'user32.dll' name 'wsprintfA';
function wsprintf5; external 'user32.dll' name 'wsprintfA';
function wsprintf6; external 'user32.dll' name 'wsprintfA';
function wsprintf7; external 'user32.dll' name 'wsprintfA';
function wsprintf8; external 'user32.dll' name 'wsprintfA';
function GetWindowUInt; external 'user32.dll' name 'GetWindowLongA';
function SetWindowUInt; external 'user32.dll' name 'SetWindowLongA';
function GetClassUInt; external 'user32.dll' name 'GetClassLongA';
function SetClassUInt; external 'user32.dll' name 'SetClassLongA';
function SendMessageP; external 'user32.dll' name 'SendMessageA';
function SendDlgItemMsgP; external 'user32.dll' name 'SendDlgItemMessageA';
function min(I1,I2:Integer):Integer;
begin if I1<I2 then Result:=I1 else Result:=I2; end;
function max(I1,I2:Integer):Integer;
begin if I1>I2 then Result:=I1 else Result:=I2; end;
function Bool2MenuCheck(x:Bool):UInt;
begin if x then Result:=MF_Checked else Result:=MF_UnChecked; end;
function IfThenElse; begin if i then Result:=t else Result:=e; end;
function IfThenElseP; begin if i then Result:=t else Result:=e; end;
procedure ShortYield;
var
Msg: TMsg;
begin
if PeekMessage(Msg,0,0,0,PM_Remove) then begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
function IsInvisible(c:Char):Boolean;
{liefert TRUE, wenn Zeichen im blichen Windows-Zeichensatz nicht sichtbar}
begin
IsInvisible:=(c<' ') or (c>=#$80) and (c<#$A0) or (c=#$FF);
end;
function EscapeStr(src:PChar; slen:UInt; dst:PChar; dlen:UInt):UInt;
{Wandelt bergebene "Bytefolge" (nicht nullterminiert) in C-String
mit Escape-Sequenzen um, auch \" und \' und \\. Nicht darstellbare
Zeichen werden in \a, \b usw. und ansonsten in Hex (\xXX) umgesetzt.
Liefert als Ergebnis die Lnge des Ergebnisstrings ohne \0.
src und dst drfen sich nicht berlappen.}
var
su:record
case Integer of
1: (c: Char);
2: (i: Integer); {Ausrichtungs-Problem bei wvsprintf}
end;
ChrCount: UInt; {geht hier nicht mit "Result"!}
function fcat(template:PChar; len:UInt):Boolean;
begin
fcat:=false;
if len<dlen then begin
if template<>nil
then wvsprintf(dst,template,su.i)
else dst^:=su.c;
Inc(dst,len);
Inc(ChrCount,len);
Dec(dlen,len);
fcat:=true;
end;
end;
begin
ChrCount:=0;
while slen>0 do begin
su.i:=0;
case src^ of
'\','"','''': su.c:=src^;
#7: su.c:='a';
#8: su.c:='b';
#9: su.c:='t';
#10: su.c:='n';
#11: su.c:='v';
#13: su.c:='r';
end;
if su.i<>0 then begin
if not fcat('\%c',2) then break;
end else begin
su.c:=src^;
if IsInvisible(su.c) then begin
if not fcat('\x%02X',4) then break;
end else begin
if not fcat(nil,1) then break;
end;
end;
Inc(src);
Dec(slen);
end{while};
if dlen>0 then dst^:=#0; {terminieren}
EscapeStr:=ChrCount;
end;
function UnescapeStr(src, dst:PChar; dlen:UInt):UInt;
{Wandelt bergebenen C-String (nullterminiert) in "Bytefolge".
Liefert als Ergebnis die Lnge der Ergebnis-Bytefolge -
diese ist nicht nullterminiert!
Da der Ergebnisstring niemals lnger wird, darf src=dst sein.}
var
su,st: Char;
e,f: Integer;
begin
Result:=0;
while dlen>0 do begin
su:=src^;
Inc(src);
if su=#0 then break;
if su='\' then begin
su:=src^;
Inc(src);
case su of
#0: break;
'0': su:=#0; {Hier: Keine Oktalzahlen - nur dieser Sonderfall}
'1'..'9': begin
Dec(src);
Val(src,Byte(su),e); {liefert als Fehler Zeichenpos+1!}
if e<>0 then begin
Dec(e);
st:=src[e];
src[e]:=#0;
Val(src,Byte(su),f); {sollte f=0 liefern, ist jedoch belanglos}
Inc(src,e);
src^:=st; {Zurckpatchen}
end else Inc(src,lstrlen(src)); {falls gerade am Stringende}
end;
'a': su:=#7;
'b': su:=#8;
't': su:=#9;
'n': su:=#10;
'v': su:=#11;
'r': su:=#13;
'x': begin
st:=src[2];
src[2]:=#0;
Dec(src);
src[0]:='$';
Val(src,Byte(su),e);
src[0]:='x'; {Zurckpatchen}
Inc(src);
src[2]:=st; {Zurckpatchen}
if e=0 then Inc(src,2) else su:='x';
end;
end{case}; {im ELSE-Fall bleibt "su" literal!}
end{if};
dst^:=su;
Inc(dst);
Inc(Result);
Dec(dlen);
end;
end;
function GetFileNamePtr(S:PChar):PChar;
{liefert Zeiger hinter das letzte Auftreten von /\: oder Stringanfang}
begin
Result:=S;
repeat
case S^ of
#0: exit;
':','\','/': Result:=S+1;
end;
S:=AnsiNext(S);
until false;
end;
function GetFileNameExt(S:PChar):PChar;
{liefert Zeiger AUF DEN PUNKT oder AUF DIE TERMINIERENDE NULL, niemals NIL}
{Als Extension gilt hierbei die Zeichenkette beginnend am _letzten_
Punkt in der _letzten_ Pfadkomponente, wenn dieser Punkt nicht
am Anfang steht (wie bei den versteckten Dateien unter UNIX)
und auch nicht als Folge von Punkten am Anfang steht (wie bei ..)
*Voraussetzung fr das korrekte Funktionieren dieser Funktion ist,
da der Dateiname keinen anhngigen Pfad-Trenner (/\:) hat.}
begin
S:=GetFileNamePtr(S);
while S^='.' do Inc(S);
Result:=nil;
repeat
case S^ of
#0: begin if Result=nil then Result:=S; exit; end;
'.': Result:=S;
end;
Inc(S);
until false;
end;
function GetRadioCheck(Wnd:HWnd; u,o:UInt):UInt;
begin
Result:=0;
while u<=o do begin
if IsDlgButtonChecked(Wnd,u)=1 then exit;
Inc(u);
Inc(Result);
end;
end;
function GetCheckboxGroup(Wnd:HWnd; u,o:UInt):UInt;
var
Mask:UInt;
begin
Result:=0;
Mask:=1;
while u<=o do begin
if IsDlgButtonChecked(Wnd,u)=1 then Result:=Result or Mask;
Inc(u);
Mask:=Mask shl 1;
end;
end;
procedure SetCheckboxGroup(Wnd:HWnd; u,o,x:UInt);
begin
while u<=o do begin
CheckDlgButton(Wnd,u,x and 1);
Inc(u);
x:=x shr 1;
end;
end;
procedure SetCheckboxGroup2(Wnd:HWnd; u,o,x:UInt);
{wie oben, belt jedoch Felder im dritten Zustand unverndert}
begin
while u<=o do begin
if IsDlgButtonChecked(Wnd,u)<2
then CheckDlgButton(Wnd,u,x and 1);
Inc(u);
x:=x shr 1;
end;
end;
function EnableDlgItem(Wnd:HWnd; idItem:UInt; Enable:Bool):Bool;
begin
HWnd(result):=GetDlgItem(Wnd,idItem);
if result then result:=EnableWindow(HWnd(result),Enable);
end;
procedure EnableDlgItemGroup(Wnd:HWnd; u,o:UInt; Enable:Bool);
begin
Dec(u);
repeat
Inc(u);
EnableDlgItem(Wnd,u,Enable);
until u=o;
end;
function ShowDlgItem(Wnd:HWnd; idItem:UInt; iShow:Integer):Bool;
begin
HWnd(result):=GetDlgItem(Wnd,idItem);
if result then result:=ShowWindow(HWnd(result),iShow);
end;
procedure ShowDlgItemGroup(Wnd:HWnd; u,o:UInt; iShow:Integer);
begin
Dec(u);
repeat
Inc(u);
ShowDlgItem(Wnd,u,iShow);
until u=o;
end;
procedure SetEditFocus(HWndEdit: HWnd);
{fokussiert+markiert Editfenster}
begin
SetFocus(HWndEdit);
SendMessage(HWndEdit,EM_SetSel,0,-1);
end;
procedure SortRect(var R:TRect);
{sortiert die Punkte, da die Zuordnungen stimmen}
var t: Integer;
begin
with R do begin
if left>right then begin t:=left; left:=right; right:=t; end;
if top>bottom then begin t:=top; top:=bottom; bottom:=t; end;
end;
end;
function ShiftRect(r,r2: PInteger):Bool;
{Kommentar siehe www.tu-chemnitz.de/~heha/messtech/sensokom.zip/dialog.c}
var ax,dx:Integer;
begin
Result:=false;
ax:=r2^-r^;
if ax=0 then exit;
if ax<0 then begin
Inc(r,2); Inc(r2,2);
dx:=r2^-r^;
if dx>=0 then exit;
if ax<dx then ax:=dx;
Dec(r,2); Dec(r2,2);
end;
Inc(r^,ax);
Inc(r,2);
Inc(r^,ax);
Result:=true;
end;
function MoveRectIntoRect(var R:TRect; const R2:TRect): Bool;
{Falls R in R2 teilweise oder vollstndig auerhalb liegt,
wird R verschoben und TRUE zurckgeliefert, um maximale Sichtbarkeit
zu realisieren.
Dient zum Hineinholen von auerhalb liegenden Fenstern in den Desktop.}
begin
Result:=Bool(Integer(ShiftRect(@R.left,@R2.left))
+Integer(ShiftRect(@R.top,@R2.top)));
end;
procedure GetFullScreenRect(var R:TRect);
{Ermittelt das Rechteck fr maximierte Fenster, d.h. die Startleiste(n)
von Win9x bereits abgezogen, ideal fr R2 in MoveRectIntoRect}
begin
with R do begin
left:=0;
top:=0;
right:=GetSystemMetrics(SM_CXFullScreen);
bottom:=GetSystemMetrics(SM_CYFullScreen)+GetSystemMetrics(SM_CYCaption);
end;
end;
procedure MoveRectIntoFullScreen(var R:TRect);
{die logische Kombination beider o.g. Routinen}
var
R2: TRect;
begin
GetFullScreenRect(R2);
MoveRectIntoRect(R,R2);
end;
function iitrafo(x,a,e,ta,te:Integer):Integer;
begin
Result:=IfThenElse(e<>a,MulDiv(x-a,te-ta,e-a)+ta,0);
end;
function lstrchr(s:PChar; c:Char):PChar;
begin
repeat
if s^=c then begin Result:=s; exit; end;
if s^=#0 then break;
s:=AnsiNext(s);
until false;
Result:=nil;
end;
function lstrcmp1(s_short,s_long:PChar;CP:TCompProc):Integer;
var
rp: PChar;
cm: Char;
begin
rp:=s_long+lstrlen(s_short);
cm:=rp^;
rp^:=#0; {patchen}
Result:=CP(s_short,s_long);
rp^:=cm; {zurckpatchen}
end;
function lstrstr(needle,heap:PChar; CP:TCompProc):PChar;
var
ln,lh,cc,cr:Integer;
cm: Char;
h_end,rp: PChar;
begin
ln:=lstrlen(needle);
lh:=lstrlen(heap);
cc:=lh-ln;
if cc<0 then begin Result:=nil; exit; end;
{Nadel lnger als Heu: kann nicht sein!}
h_end:=heap+cc;
while heap<=h_end do begin
rp:=heap+ln;
cm:=rp^;
rp^:=#0; {Patch!}
cr:=CP(heap,needle);
rp^:=cm; {Rckpatch!}
if cr=0 then begin Result:=heap; exit; end;
heap:=AnsiNext(heap);
end;
Result:=nil;
end;
procedure InitStruct(var s; slen:Integer);
begin
ZeroMemory(@s,slen);
PInteger(@s)^:=slen;
end;
end.
(*
function min(I1,I2:Integer):Integer; {Integer=LongInt}
inline($58/$59/$39/$C8/$7C/$01/$91);
{pop eax; pop ecx; cmp eax,ecx; jl $+3; xchg ecx,eax}
function max(I1,I2:Integer):Integer;
inline($58/$59/$39/$C8/$7F/$01/$91);
{pop eax; pop ecx; cmp eax,ecx; jg $+3; xchg ecx,eax}
*)
| Vorgefundene Kodierung: UTF-8 | 0
|