unit turbo;

interface
uses windows,dialogs,sysutils,Graphics,Controls,ExtCtrls;
type
  EQueueException=class(exception);
  TQueueFIFO=class
    daten:array of Pointer;
    anfang,ende:integer;
    voll:boolean;
    constructor Create(size:cardinal);
    function getFirst:pointer;
    procedure add(const p:pointer);
    procedure delFirst;
    procedure ClearAll;
    function IsEmpty:boolean;
  end;
  EStackException=class(exception);
  TStackLIFO=class
    daten:array of Pointer;
    ende:integer;
    constructor Create(size:cardinal);
    function getLast:pointer;
    procedure add(const p:pointer);
    procedure delLast;
    procedure ClearAll;
    function IsEmpty:boolean;
  end;

  TStackLIFOobj=class
    daten:array of TObject;
    ende:integer;
    constructor Create(size:cardinal);
    function getLast:TObject;
    procedure add(const p:TObject);
    procedure delLast;
    procedure ClearAll;
    function IsEmpty:boolean;
  end;

  ELLException=class(exception);
  TLLElement=class
    next:TLLElement;
    wert:pointer;
    constructor create;
  end;
  TLinkedList=class
    size:integer;
    start,ende:TLLElement;
    constructor create;
    procedure add(const p:pointer);
    procedure del(number:integer);
    function get(number:integer):pointer;
    function getSize:integer;
  end;
function Exponent(base, exp: LongInt): int64;  // Exponent-Funktion
function Hex2Dec(hex: STRING): int64; //hex to longint
function runonNT:boolean;
function IfThen(const b:boolean;const s1:string;const s2:string):string;//Ersatz für den C/Java ausruck b?s1:s2. Benutzung so: ifThen(b,s1,s2);
function GetVolumenName(volume:string):string;
function MakeString(str:string;count:cardinal):string;
function Code(Text: string;Code: Char): string;
function ZColor: TColor;
function ZBoolean: Boolean;
function Spalt(Satz: string; Trennz: Char): string;
procedure ResPlay(Name: String);
procedure aResPlay(Name: String);
procedure SuperResPlay(Name: String;Modus : word);
function PosVergleichShape(X,Y,Breite,Hoehe : integer; Shape:TShape;NurAktiv:boolean): Boolean;
function PosVergleichImage(X,Y,Breite,Hoehe : integer; Image:TImage;NurAktiv:boolean): Boolean;
function AufHellenDurchAddition(const c:TColor;const hell:smallint):TColor; //Hellt eine Farbe durch Addition auf
function SetHelligkeit(const c:TColor;const hell:smallint):TColor; //Hellt eine Farbe auf, indem ihre Position auf einem imaginären Farbverlauf gemessen wird
//function Spalt(
implementation
uses WinProcs,mmsystem;

constructor TQueueFIFO.Create(size:cardinal);
begin
  setlength(daten,size);
  ClearAll;
end;
procedure TQueueFIFO.ClearAll;
begin
  anfang:=0;
  ende:=0;
  voll:=false;
end;

function TQueueFIFO.IsEmpty:boolean;
begin
  Result:=(anfang=ende) and not voll;
end;
function TQueueFIFO.getFirst:pointer;
begin
  if IsEmpty then
    raise EQueueException.Create('Versuch aus einer leeren Schlange zu lesen');
  result:=daten[anfang];
end;
procedure TQueueFIFO.add(const p:pointer);
begin
  if voll then
    raise EQueueException.Create('Versuch in eine volle Schlange zu schreiben');
  daten[ende]:=p;
  ende:=ende+1;
  if (ende>=length(daten)) then ende:=0;
  if (isEmpty()) then voll:=true;
end;
procedure TQueueFIFO.delFirst;
begin
  if IsEmpty then
    raise EQueueException.Create('Versuch aus einer leeren Schlange zu lesen');
  //daten[anfang]:=nil;
  voll:=false;
  Inc(anfang);
  if (anfang>=length(daten))then
    anfang:=0;
end;
{
################################################################################
================================================================================
--------------------------------------------------------------------------------
................................................................................
                                   TStackLIFO
................................................................................
--------------------------------------------------------------------------------
================================================================================
################################################################################
}
constructor TStackLIFO.Create(size:cardinal);
begin

  setlength(daten,size);
  ClearAll;
end;
function TStackLIFO.getLast:pointer;
begin
  if ende<0 then
    raise EStackException.Create('Versuch aus einem leeren Stack zu lesen');
  result:=daten[ende];
end;
procedure TStackLIFO.add(const p:pointer);
begin
  if ende=high(daten) then
    raise EStackException.Create('Versuch in einen vollen Stack zu schreiben');
  inc(ende);
  daten[ende]:=p;
end;
procedure TStackLIFO.delLast;
begin
  if ende<0 then
    raise EStackException.Create('Versuch aus einem leeren Stack zu lesen');
  dec(ende);
end;
procedure TStackLIFO.ClearAll;
begin
  ende:=-1;
end;
function TStackLIFO.IsEmpty:boolean;
begin
  result:=ende<0;
end;
{
################################################################################
================================================================================
--------------------------------------------------------------------------------
................................................................................
                                 TStackLIFOobj
................................................................................
--------------------------------------------------------------------------------
================================================================================
################################################################################
}
constructor TStackLIFOobj.Create(size:cardinal);
begin
  setlength(daten,size);
  ClearAll;
end;
function TStackLIFOobj.getLast:TObject;
begin
  if ende<0 then
    raise EStackException.Create('Versuch aus einem leeren Stack zu lesen');
  result:=daten[ende];
end;
procedure TStackLIFOobj.add(const p:TObject);
begin
  if ende=high(daten) then
    raise EStackException.Create('Versuch in einen vollen Stack zu schreiben');
  inc(ende);
  daten[ende]:=p;
end;
procedure TStackLIFOobj.delLast;
begin
  if ende<0 then
    raise EStackException.Create('Versuch aus einem leeren Stack zu lesen');
  dec(ende);
end;
procedure TStackLIFOobj.ClearAll;
begin
  ende:=-1;
end;
function TStackLIFOobj.IsEmpty:boolean;
begin
  result:=ende<0;
end;

{
################################################################################
================================================================================
--------------------------------------------------------------------------------
................................................................................
                                 TLinkedList
................................................................................
--------------------------------------------------------------------------------
================================================================================
################################################################################
}
constructor TLLElement.create;
begin
  next:=nil;
end;
constructor TLinkedList.create;
begin
  size:=0;
end;

procedure TLinkedList.add(const p:pointer);

begin
if (ende=nil) then begin
  start:=TLLElement.Create;
  start.wert:=p;
  ende:=start;
  size:=1;
end else begin
  ende.next:=TLLElement.Create;
  ende:=ende.next;
  ende.wert:=p;
  size:=size+1;
end;
end;

procedure TLinkedList.del(number:integer);
var pos,vorpos:TLLElement;
begin
vorpos:=nil;
pos:=start;
for number:=2 to number do begin
  vorpos:=pos;
  pos:=pos.next;
end;
if vorpos<>nil then begin
  vorpos.next:=pos.next;
  if vorpos.next=nil then
    ende:=vorpos;
end else
  start:=pos.next;
pos.free;
dec(size);
end;

function TLinkedList.get(number:integer):pointer;
var pos:TLLElement;
begin
  pos:=start;
  for number:=2 to number do
    pos:=pos.next;
  result:=pos.wert;
end;

function TLinkedList.getSize:integer;
begin
  result:=size;
end;

function Exponent(base, exp: LongInt): int64;  // Exponent-Funktion
VAR erg: LONGINT;
    i: Integer;
    BEGIN
      IF exp=0 THEN
         Exponent:=1
      ELSE
        BEGIN
         erg:=base;
         FOR i:= 1 TO exp-1 DO
           erg:=erg*base;
         Exponent:=erg;
        END;
    END;


function Hex2Dec(hex: STRING): int64;
VAR i,j,dummy,zahl: Integer;  // Hex-Zahlen in Deziaml-Zahlen
    ergebnis: int64;        // konvertieren
    BEGIN
    zahl:=0;
      ergebnis:=0;
      j:=-1;
      FOR i:= Length(hex) DOWNTO 1 DO
        BEGIN
          j:=j+1;
        CASE UpCase(hex[i]) OF
         '0'..'9': val(hex[i],zahl,dummy);
              'A': zahl:=10;
              'B': zahl:=11;
              'C': zahl:=12;
              'D': zahl:=13;
              'E': zahl:=14;
              'F': zahl:=15;
        ELSE
         BEGIN
           ergebnis:=0;
           Break;
         END;
        END;
        ergebnis:=ergebnis+(zahl*exponent(16,j));
        END;
      Hex2Dec:=ergebnis;
    END;

function runonNT:boolean;
var vinfo:OSVERSIONINFO;
begin
  zeromemory(@vinfo,sizeof(vinfo));
  vinfo.dwOSVersionInfoSize:=sizeof(vinfo);
  GetVersionEx(vinfo);
  runonNT:= vinfo.dwPlatformId=VER_PLATFORM_WIN32_NT;
end;

function IfThen(const b:boolean;const s1:string;const s2:string):string;//Ersatz für den C/Java ausruck b?s1:s2. Benutzung so: ifThen(b,s1,s2);
begin
  if b then result:=s1
  else result:=s2;
end;

function GetVolumenName(volume:string):string;
var vn:array[0..255] of char;
    temp:cardinal;
begin
GetVolumeInformation(pchar(volume),vn,255,nil,temp,temp,nil,0);
result:=vn;
end;

function MakeString(str:string;count:cardinal):string;
begin
  case count of
    0: result:='';
    1: result:=str;
    else begin
      if count and $00000001 = $00000001 then result:=str;
      str:=str+str;
      for count:=1 to count div 2 do
        result:=result+str;
    end;
end;
end;

function PosVergleichShape(X,Y,Breite,Hoehe : integer; Shape:TShape;NurAktiv:boolean): Boolean;
begin
Result := false;
if NurAktiv = true then

   if (X +Breite>= Shape.Left) and (x <= Shape.Left + Shape.Width) and
     (y +Hoehe>= Shape.top) and (y <=Shape.top + Shape.Height) and (Shape.Visible = true) then begin
     Result := True;
    end;
if NurAktiv = false then
    if (X +Breite>= Shape.Left) and (x <= Shape.Left + Shape.Width) and
     (y +Hoehe>= Shape.top) and (y <=Shape.top + Shape.Height) then begin
     Result := True;
    end;




end;


function PosVergleichImage(X,Y,Breite,Hoehe : integer; Image:TImage;NurAktiv:boolean): Boolean;
begin
Result := false;
if NurAktiv = true then
   if (X +Breite>= Image.Left) and (x <= Image.Left + Image.Width) and
     (y +Hoehe>= Image.top) and (y <=Image.top + Image.Height) and (Image.Visible = true) then begin
     Result := True;
    end;
if NurAktiv = false then
    if (X +Breite>= Image.Left) and (x <= Image.Left + Image.Width) and
     (y +Hoehe>= Image.top) and (y <=Image.top + Image.Height) then begin
     Result := True;
    end



end;


procedure ResPlay(Name:String);
var Res,Reshandle:THandle;
begin
Res:=FindResource(HInstance,PCHAR(Name),'WAVE');

if Res <> 0 then begin
  Reshandle := LoadResource(HInstance,Res);
  if Reshandle <> 0 then begin
    sndPlaySound(LockResource(ResHandle),snd_SYNC or SND_MEMORY);
    UnlockResource(Reshandle);
    FreeResource(Reshandle);
  end;
end;
end;

procedure aResPlay(Name:String);
var Res,Reshandle:THandle;
begin
Res:=FindResource(HInstance,PCHAR(Name),'WAVE');

if Res <> 0 then begin
  Reshandle := LoadResource(HInstance,Res);
  if Reshandle <> 0 then begin
    sndPlaySound(LockResource(ResHandle),snd_ASYNC or SND_MEMORY);
    UnlockResource(Reshandle);
    FreeResource(Reshandle);
  end;
end;
end;


procedure SuperResPlay(Name:String;Modus:word);
var Res,Reshandle:THandle;
begin
Res:=FindResource(HInstance,PCHAR(Name),'WAVE');

if Res <> 0 then begin
  Reshandle := LoadResource(HInstance,Res);
  if Reshandle <> 0 then begin
    sndPlaySound(LockResource(ResHandle),Modus or SND_MEMORY);
    UnlockResource(Reshandle);
    FreeResource(Reshandle);
  end;
end;
end;


function ZBoolean: Boolean;
begin
randomize;
Result := Random(2) = 1;
end;

function Spalt(Satz: string; Trennz: Char): string;
var I,L,X: integer;
    S: string;
begin
L := Length(Satz);
for I := 1 to L do
if Satz[I] = Trennz then X := I + 1;

for I := X to L do
 S := S + Satz[I];

Result := S;
end;

function Code(Text: string;Code: Char): string;
var A: cardinal;
begin
for A := 1 to Length(Text) do
  Result := Result + chr((ord(Text[A]) xor ord(Code)));


end;

function ZColor:TColor;
begin
randomize;
Result := RGB(Random(255),Random(255),Random(255));

end;

function toByte(b:integer):byte;
begin
  if b<0 then result:=0
  else if b>255 then result:=255
  else result:=b;
end;

function SetHelligkeit(const c:TColor;const hell:smallint):TColor;
var r,g,b:integer;
    rfg_fd,gfg_fd,bfg_fd:double;//Geschwindigkeit der Farbveränderung auf dem Balken
begin
//  c:=$00004080;
  if hell=0 then
    result:=c
  else begin
    r:=GetRValue(c);
    g:=GetGValue(c);
    b:=GetBValue(c);
    if hell<0 then begin
      rfg_fd:=r / 256;
      gfg_fd:=g / 256;
      bfg_fd:=b / 256;
      r:=toByte({256+}trunc(hell*rfg_fd)+r);
      g:=toByte({256+}trunc(hell*gfg_fd)+g);
      b:=toByte({256+}trunc(hell*bfg_fd)+b);
    end else if hell>0 then begin
      rfg_fd:=abs(r-256) / 256;
      gfg_fd:=abs(g-256) / 256;
      bfg_fd:=abs(b-256) / 256;
      r:=toByte(trunc(hell*rfg_fd)+r);
      g:=toByte(trunc(hell*gfg_fd)+g);
      b:=toByte(trunc(hell*bfg_fd)+b);
    end;                      
    Result:=rgb(r,g,b);
  end;
end;

function AufHellenDurchAddition(const c:TColor;const hell:smallint):TColor;
begin
  result:=rgb(toByte(GetRValue(c)+hell),toByte(GetGValue(c)+hell),toByte(GetBValue(c)+hell));
end;
end.
