Source file: /~heha/messtech/motor.zip/SRC/SMSP.PAS

unit smsp;
{Sammlung diverser allgemeiner Unterprogramme zum Thema
 * Zahlen-Konvertierung
 * Zahlen-String-Konvertierung
 * Meldungsbox mit String-ID
 * Mul und Div (eher Selbstzweck)
}
interface
uses WinProcs,WinTypes,Strings,WinDos,SMSH,MPK3D;

function GetProfileReal(Entry:PChar; var Z:TReal):Boolean;
function WriteProfileReal(Entry:PChar; var Z:TReal):Boolean;

function GetReal(HWindow:HWnd; ID: Word; var Z:TReal):boolean;

function Real2S(Z:TReal; F:Integer; S:PChar):PChar;
function S2Real(S:PChar; var Z: TReal):boolean;

function HinweisFrage(Window:HWnd; ID:Word; var p; TextType:Word):Integer;
function HinweisV(Window:HWnd; ID:Word; var P):Integer;	{var-args}
function Hinweis1(Window:HWnd; ID:Word; S:PChar):Integer; {1 arg}
{Notfalls auch 2 Integer-Argumente mit PChar(MakeLong(Par2,Par1)) }

procedure ShortYield;

function VxDsupR(Kdo: Byte; Z1,Z2:TReal):Boolean;

function LongMul(F1,F2:Integer):LongInt;
 inline($5A/$58/$F7/$EA);	{pop dx; pop ax; imul dx}
function ULongMul(F1,F2:Word):LongInt;
 inline($5A/$58/$F7/$E2);	{pop dx; pop ax; mul dx}
function LongDiv(Z:LongInt; N:Integer):Integer;
 inline($59/$58/$5A/$F7/$F9);	{pop cx; pop ax; pop dx; idiv cx}
function ULongDiv(Z:LongInt; N:Word):Word;
 inline($59/$58/$5A/$F7/$F1);	{pop cx; pop ax; pop dx; div cx}
function ULongMod(Z:LongInt; N:Word):Word;
 inline($59/$58/$5A/$F7/$F1/$87/$C2);
 {pop cx; pop ax; pop dx; div cx; xchg ax,dx}

implementation

function GetProfileReal(Entry:PChar; var Z:TReal):Boolean;
 var
  S:TS31;
 begin
  Real2S(Z,3,S);
  GetPrivateProfileString(Section,Entry,S,S,sizeof(S),Profile);
  GetProfileReal:=S2Real(S,Z);
 end;

function WriteProfileReal(Entry:PChar; var Z:TReal):Boolean;
 var
  S:TS31;
 begin
  Real2S(Z,3,S);
  WriteProfileReal:=WritePrivateProfileString(Section,Entry,S,Profile);
 end;

function GetReal(HWindow:HWnd; ID: Word; var Z:TReal):boolean;
 var
  S: TS31;
 begin
  GetDlgItemText(HWindow,ID,S,sizeof(S));
  GetReal:=S2Real(S,Z);
 end;

function Real2S(Z:TReal; F:Integer; S:PChar):PChar;
{Diese Funktion arbeitet wie Str(Z:F:F,S), jedoch werden unnötige
 Nachkommastellen (Nullen) abgeschnitten}
{Der Str-Syntaxcheck ist buggy; daher mit wildem Typecast ruhigstellen}
 begin
  Str(Z:F:F,TS255(Pointer(S)^));	{mittels Systemfunktion wandeln}
  Real2S:=S;		{Stringzeiger durchreichen}
  S:=StrScan(S,'.');	{Dezimalpunkt enthalten?}
  if S<>nil then begin
   S:=StrEnd(S);	{Auf die Null}
   repeat
    Dec(S);		{Zeiger aufs Stringende (vor die Null)}
    if S^='.' then begin {String besteht nur (noch) aus dem Dezimalpunkt?}
     S^:=#0;		{String kürzen und raus!}
     break;
    end;
    if S^='0' then S^:=#0	{Stringende ist die Null? - Kürzen und weiter}
    else break;		{sonst raus!}
   until false;
  end;
 end;

function S2Real(S:PChar; var Z: TReal):boolean;
{wie Val(), jedoch vorher Komma zu Punkt wandeln}
{Weißraum (TAB & SPC) am Anfang wird übergangen, Weißraum (#0..' ')
 am Ende auch, beim Abhacken wird das Zeichen zwischendurch gemerkt.
 Achtung: Bei Fehler wird eine 0.0 in die Variable Z geschrieben!}
 var
  I:Integer;
  SP: PChar;
  MemChr: Char;
 begin
  while (S^=' ') or (S^=#9) do Inc(S);	{Weißraum am Anfang übergehen}
  SP:=StrScan(S,',');
  if SP<>nil then SP^:='.';	{Komma zum Punkt machen}
  SP:=S;
  while SP^>' ' do Inc(SP);	{Ende des Strings suchen}
  MemChr:=SP^; SP^:=#0;		{Zeichen merken, String abhacken}
  Val(S,Z,I);
  SP^:=MemChr;			{Zeichen zurückschreiben}
  S2Real:= (I=0);		{false wenn Fehler in Real-Zahl}
 end;

function HinweisFrage(Window:HWnd; ID:Word; var p; TextType:Word):Integer;
{HINWEIS lädt einen String aus der Resource mit der entsprechenden ID und
zeigt ihn in einer Messagebox an. Da Resourcenstrings ein Längenbyte haben,
dient ein eventuelles #0-Zeichen im String als Trenner zwischen Text und Titel}
 var
  S,S2: TS255;			{2 Puffer; leider so erforderlich}
  S1: PChar;			{zeigt in S oder ist nil}
  I: Integer;
 begin
  MessageBeep(TextType);
  I:=LoadString(HInstance,ID,S,sizeof(S)); {I=Anzahl der Zeichen insgesamt}
  if I=lStrLen(S) then S1:=nil	{Kein #0-Zeichen dazwischen: Titel="Fehler"}
  else S1:=StrEnd(S)+1;		{ein #0-Zeichen: Titel=nachfolgender String}
  wvsprintf(S2,S,P);
  HinweisFrage:=MessageBox(Window,S2,S1,TextType);
 end;

function HinweisV(Window:HWnd; ID:Word; var p):Integer;
 begin
  HinweisV:=HinweisFrage(Window,ID,p,MB_OK or MB_IconExclamation);
 end;

function Hinweis1(Window:HWnd; ID:Word; S:PChar):Integer;
 begin
  Hinweis1:=HinweisV(Window,ID,S);
 end;

procedure ShortYield;
 var
  Msg: TMsg;
 begin
  if PeekMessage(Msg,0,0,0,PM_Remove) then begin
   TranslateMessage(Msg);
   DispatchMessage(Msg);
  end;
 end;

function VxDsupR(Kdo: Byte; Z1,Z2:TReal):Boolean;
 begin
  VxDsupR:=VxDsupC(Kdo,UnitUsed,Round(Z1*Faktor),Round(Z2*Faktor))=0;
 end;

end.