2 Projekte abzugeben

[Dust Signs]

Complex Calculator ca. 2000 Zeilen, Terminplaner weiß ich nicht auswendig - aber ich nehme an irgendwas zwischen 20000 und 30000. Terminplaner müsste IIRC ab Delphi 6 (viell. auch ab 5 - weiß ich nicht sicher), Complex Calculator ab Delphi 7 (viell. auch 6) gehen. Es wurden nirgendwo Fremdkomponenten verwendet.

Dust Signs

//EDIT: vielleicht um Interessenten anzulocken mal ein paar Schnippsel Code bzw. ein paar kleine Units des Terminplaners und des Complex Calculators. Wie schon gesagt: Complex Calculator ist kommentiert, der Terminplaner nicht

Terminplaner dsdsmgr.pas:

Delphi-Quellcode:

{************************************}
{*                                  *}
{*      DS Date Sharing Manager     *}
{*                                  *}
{*   © by Andreas Unterweger 2004   *}
{*                                  *}
{************************************}

unit dsdsmgr;

interface

uses ds_core, Unit1, SysUtils, Dialogs, Unit5;

type
  TStringArray = Array of String;
  TSharedTerminListArray = Array of record
                                      TerminList: TTerminList;
                                      User: String;
                                      end;
  TCheckState = (csDoesntExist, csIsOlder, csIsUpToDate);
  TDateAction = (daAdd, daUpdate, daNone);
  TUpdateTermin = record
                    Termin: TTermin;
                    Action: TDateAction;
                    end;
  TUpdateTerminList = Array of TUpdateTermin;

  function CreateSharedTerminList(TerminList: TTerminList): TTerminList;
    function GetUsers(Users: String): TStringArray;
    function UserExists(UserArray: TSharedTerminListArray; User: String): Boolean;
    function GetUserPos(UserArray: TSharedTerminListArray; User: String): Integer;
  function SeparateTerminLists(TerminList: TTerminList): TSharedTerminListArray;
  procedure SaveSharedTerminLists(UserArray: TSharedTerminListArray; UseOldName: String = '');
procedure SaveSharedDates(TerminList: TTerminList; UseOldName: String = '');
function LoadSharedDates(User, SharedUser: String): TTerminList;
  function SUIDToIndex(SUID: Integer; TerminList: TTerminList): Integer;
function CheckSharedTermin(t: TTermin; TerminList: TTerminList): TCheckState;
procedure Synchronize(var TerminList: TTerminList; Update: TUpdateTerminList);
procedure DeleteDateBySUID(var TerminList: TTerminList; SUID: Integer);

implementation

function CreateSharedTerminList(TerminList: TTerminList): TTerminList;
var
  i: Integer;
begin
  SetLength(Result, 0);
  for i := Low(TerminList) to High(TerminList) do begin
    if TerminList[i].Shared.Shared then begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := TerminList[i];
      end;
    end;
end;

function GetUsers(Users: String): TStringArray;
var
  s, t: String;
begin
  SetLength(Result, 0);
  s := Users;
  while s <> '' do begin
    SetLength(Result, Length(Result) + 1);
    if Pos(';', s) = 0 then begin
      t := s;
      s := '';
    end else begin
      t := Copy(s, 1, Pos(';', s) - 1);
      Delete(s, 1, Pos(';', s));
      end;
    Result[High(Result)] := t;
    end;
end;

function UserExists(UserArray: TSharedTerminListArray; User: String): Boolean;
begin
  Result := (GetUserPos(UserArray, User) <> -1);
end;

function GetUserPos(UserArray: TSharedTerminListArray; User: String): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := Low(UserArray) to High(UserArray) do begin
    if UserArray[i].User = User then begin
      Result := i;
      exit;
      end;
    end;
end;

function SeparateTerminLists(TerminList: TTerminList): TSharedTerminListArray;
var
  i, j: Integer;
  a: TStringArray;
begin
  SetLength(Result, 0);
  for i := Low(TerminList) to High(TerminList) do begin
    a := GetUsers(TerminList[i].Shared.SharedUsers);
    for j := Low(a) to High(a) do begin
      if not(UserExists(Result, a[j])) then begin
        //user does not exist --> create
        SetLength(Result, Length(Result) + 1);
        Result[High(Result)].User := a[j];
        SetLength(Result[High(Result)].TerminList, 1);
        Result[High(Result)].TerminList[0] := TerminList[i];
      end else begin
        //user already exists --> add
        SetLength(Result[GetUserPos(Result, a[j])].TerminList, Length(Result[GetUserPos(Result, a[j])].TerminList) + 1);
        Result[GetUserPos(Result, a[j])].TerminList[High(Result[GetUserPos(Result, a[j])].TerminList)] := TerminList[i];
        end;
      end;
    end;
end;

procedure SaveSharedTerminLists(UserArray: TSharedTerminListArray; UseOldName: String = '');
var
  i: Integer;
  dummy: TTerminList;
  dummy2: String;
begin
  if Length(UserArray) = 0 then begin {empty sync save}
    dummy := termine;
    termine := nil;
    dummy2 := allowedusers;
    if UseOldName <> '' then
      allowedusers := act_user + ';' + UseOldName;
    if UseOldName <> '' then
      Form1.SaveArrayNew(r_fp + 'Users\' + act_user + '\s_data.' + UseOldName + '.dstkf');
    allowedusers := dummy2;
    termine := dummy;
    end;
  for i := Low(UserArray) to High(UserArray) do begin
    dummy := termine;
    termine := UserArray[i].TerminList;
    dummy2 := allowedusers;
    if UseOldName <> '' then
      allowedusers := act_user + ';' + UseOldName
    else
      allowedusers := act_user + ';' + UserArray[i].User;
    if UseOldName <> '' then
      Form1.SaveArrayNew(r_fp + 'Users\' + UserArray[i].User + '\s_data.' + UseOldName + '.dstkf')
    else
      Form1.SaveArrayNew(r_fp + 'Users\' + UserArray[i].User + '\s_data.' + act_user + '.dstkf');
    allowedusers := dummy2;
    termine := dummy;
    end;
end;

procedure SaveSharedDates(TerminList: TTerminList; UseOldName: String = '');
begin
  SaveSharedTerminLists(SeparateTerminLists(CreateSharedTerminList(TerminList)), UseOldName);
end;

function LoadSharedDates(User, SharedUser: String): TTerminList;
var
  temp: TTerminList;
begin
  temp := termine;
  Form1.LoadArray(false, r_fp + 'Users\' + User + '\s_data.' + SharedUser + '.dstkf');
  Result := termine;
  termine := temp;
end;

function SUIDToIndex(SUID: Integer; TerminList: TTerminList): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := Low(TerminList) to High(TerminList) do begin
    if TerminList[i].Shared.SharedUID = SUID then begin
      Result := i;
      exit;
      end;
    end;
end;

function CheckSharedTermin(t: TTermin; TerminList: TTerminList): TCheckState;
var
  i: Integer;
begin
  i := SUIDToIndex(t.Shared.SharedUID, TerminList);
  if i = -1 then begin
    Result := csDoesntExist;
    exit;
    end;
  if t.Shared.LastUpdate > TerminList[i].Shared.LastUpdate then
    Result := csIsOlder
  else
    Result := csIsUpToDate;
end;

procedure Synchronize(var TerminList: TTerminList; Update: TUpdateTerminList);
var
  i: Integer;
begin
  for i := Low(Update) to High(Update) do begin
    case Update[i].Action of
      daAdd: AddTermin(TerminList, Update[i].Termin);
      daUpdate: EditTermin(TerminList, SUIDToIndex(Update[i].Termin.Shared.SharedUID, TerminList), Update[i].Termin);
//      daNone: ;  // do nothing
      end;
    end;
end;

procedure DeleteDateBySUID(var TerminList: TTerminList; SUID: Integer);
begin
  EraseTermin(TerminList, SUIDToIndex(SUID, TerminList));
end;

end.

Terminplaner dscore.pas:

Delphi-Quellcode:

{************************************}
{*                                  *}
{*     DSTP Core Date Management    *}
{*                                  *}
{*   © by Andreas Unterweger 2004   *}
{*                                  *}
{************************************}

unit ds_core;

interface

uses SysUtils;

type
  TTermin = packed record
    Index: Integer;
    DateType: Byte;
    Priority: Byte;
    Description: String;
    Comment: String;
    Time: TDateTime;
    Contact: String;
    Date: TDateTime;
    Hidden: Boolean;
    Warnings: Array of TDateTime;
    _Until: packed record
      _Until: Boolean;
      Date: TDateTime;
      Time: TDateTime;
      end;
    Shared: packed record
      Shared: Boolean;
      SharedUID: Integer;
      SharedUsers: String;
      LastUpdate: TDateTime;
      end;
    end;

type
  TWarnTermin = packed record
    Beschreibung: String;
    Date: TDateTime;
    Uhrzeit: TDateTime;
    WarningTime: TDateTime;
    end;

type
  TTerminList = Array of TTermin;
  PTerminList = ^TTerminList;

procedure ShellSort(var TerminList: TTerminList);
procedure AddTermin(var TerminList: TTerminList; Termin: TTermin); overload;
procedure AddTermin(var TerminList: TTerminList; Termine: Array of TTermin); overload;
function GetTermin(var TerminList: TTerminList; Position: Integer): TTermin;
procedure EditTermin(var TerminList: TTerminList; Position: Integer; NewTermin: TTermin);
procedure EraseTermin(var TerminList: TTerminList; Position: Integer);
function TerminListLength(var TerminList: TTerminList): Integer;
function FindFirstTerminOfDate(var TerminList: TTerminList; Date: TDateTime): Integer;
function FindLastTerminOfDate(var TerminList: TTerminList; Date: TDateTime): Integer;
function TerminAlreadyExists(var TerminList: TTerminList; Date: TDateTime; Caption: String): Boolean;
procedure Indexate(var TerminList: TTerminList);
function TerminInYearExists(var TerminList: TTerminList; Year: Word): Boolean;
function FindTerminToDate(var TerminList: TTerminList; Date: TDateTime): Integer;

implementation

procedure ShellSort(var TerminList: TTerminList);
var
  i, j, k, l: LongInt;
  t: TTermin;
begin
  l := High(TerminList);
  //
  if l = 1 then begin
    if (TerminList[1].Date + TerminList[1].Time) < (TerminList[0].Date + TerminList[0].Time) then begin
      t := TerminList[0];
      TerminList[0] := TerminList[1];
      TerminList[1] := t;
      exit;
      end;
    end;
  //
  k := l shr 1;
  while k > 0 do begin
    for i := 0 to l - k do begin
      j := i;
      while (j >= 0) and ((TerminList[j].Date + TerminList[j].Time) > (TerminList[j + k].Date + TerminList[j + k].Time)) do begin
        t := TerminList[j];
        TerminList[j] := TerminList[j + k];
        TerminList[j + k] := t;
        if j > k then
          Dec(j, k)
        else
          j := 0;
        end;
      end;
    k := k shr 1;
    end;
end;

procedure AddTermin(var TerminList: TTerminList; Termin: TTermin);
begin
  SetLength(TerminList, Length(TerminList) + 1);
  TerminList[High(TerminList)] := Termin;
  ShellSort(TerminList);
  Indexate(TerminList);
end;

function GetTermin(var TerminList: TTerminList; Position: Integer): TTermin;
begin
  Result := TerminList[Position];
end;

procedure EditTermin(var TerminList: TTerminList; Position: Integer; NewTermin: TTermin);
begin
  TerminList[Position] := NewTermin;
  ShellSort(TerminList);
  Indexate(TerminList);
end;

procedure EraseTermin(var TerminList: TTerminList; Position: Integer);
var
  i: Integer;
begin
  for i := Position to High(TerminList) - 1 do
    TerminList[i] := TerminList[i + 1];
  SetLength(TerminList, Length(TerminList) - 1);
  ShellSort(TerminList);
  Indexate(TerminList);
end;

function TerminListLength(var TerminList: TTerminList): Integer;
begin
  Result := High(TerminList);
end;

function FindFirstTerminOfDate(var TerminList: TTerminList; Date: TDateTime): Integer;
var
  i, j: Integer;
begin
  j := -1;
  for i := 0 to TerminListLength(TerminList) do begin
    if TerminList[i].Date = Date then begin
      j := i;
      break;
      end;
    if TerminList[i].Date > Date then
      break;
    end;
  Result := j;
end;

function FindLastTerminOfDate(var TerminList: TTerminList; Date: TDateTime): Integer;
var
  i, j, k: Integer;
begin
  Result := -1;
  k := -1;
  j := FindFirstTerminOfDate(TerminList, Date);
  if j = -1 then
    exit;
  for i := j to TerminListLength(TerminList) do begin
    k := i - 1;
    if TerminList[i].Date > Date then
      break;
    end;
  if (k = (TerminListLength(TerminList) - 1)) and (TerminList[k + 1].Date = Date) then //falls letzter Termin
    Result := k + 1
  else
    Result := k;
end;

function TerminAlreadyExists(var TerminList: TTerminList; Date: TDateTime; Caption: String): Boolean;
var
  i: Integer;
begin
  for i := 0 to TerminListLength(TerminList) do begin
    if (TerminList[i].Date = Date) and (TerminList[i].Description = Caption) then begin
      Result := true;
      exit;
      end;
    end;
  Result := false;
end;

procedure Indexate(var TerminList: TTerminList);
var
  i: Integer;
begin
  for i := 0 to TerminListLength(TerminList) do
    TerminList[i].Index := i; 
end;

function TerminInYearExists(var TerminList: TTerminList; Year: Word): Boolean;
var
  i: Integer;
  y, m, d: Word;
begin
  for i := 0 to TerminListLength(TerminList) do begin
    DecodeDate(TerminList[i].Date, y, m, d);
    if y = Year then begin
      Result := true;
      exit;
      end;
    end;
  Result := false;
end;

procedure AddTermin(var TerminList: TTerminList; Termine: Array of TTermin);
var
  oldlength, i: Integer;
begin
  oldlength := Length(TerminList);
  SetLength(TerminList, oldlength + Length(Termine));
  for i := Low(Termine) to High(Termine) do
    TerminList[oldlength + i] := Termine[i];
  ShellSort(TerminList);
  Indexate(TerminList);
end;

function FindTerminToDate(var TerminList: TTerminList; Date: TDateTime): Integer;
var
  i, j: Integer;
begin
  j := -1;
  for i := 0 to TerminListLength(TerminList) do begin
    if TerminList[i].Date = Date then begin
      j := i;
      break;
      end;
    if TerminList[i].Date > Date then begin
      j := i - 1;
      break;
      end;
    end;
  Result := j;
end;

end.

Complex Calculator, Ausschnitt aus cmpxmain.pas:

Delphi-Quellcode:

//CompToPolar  
//  Wandelt Komponenten- in Polardarstellung um  
//Parameter:  
//  - Realteil  
//  - Imaginärteil  
//  - Betrag (Ergebnis)  
//  - Winkel (Ergebnis)  
//Ergebnis:  
//  true wenn erfolgreich, ansonsten false  
function CompToPolar(RealT, ImgT: Double; var Betrag, Winkel: Double): Boolean;  
begin  
  Result := true;  
  try  
    Betrag := Sqrt(Sqr(RealT) + Sqr(ImgT)); //Realteil² + Imaginärteil²  
    Winkel := ArcTan2(ImgT, RealT);  
   except  
    Result := false;  
    end;  
end;  

 
//PolarToComp  
//  Wandelt Polar- in Komponentendarstellung um  
//Parameter:  
//  - Betrag (Ergebnis)  
//  - Winkel  
//  - Realteil (Ergebnis)  
//  - Imaginärteil (Ergebnis)  
//Ergebnis:  
//  true wenn erfolgreich, ansonsten false  
function PolarToComp(Betrag, Winkel: Double; var RealT, ImgT: Double): Boolean;  
begin  
  Result := true;  
  try  
    Winkel := Frac(Winkel / (2 * Pi)) * 2 * Pi;
    RealT := Betrag * Cos(Winkel); //Betrag * Cosinus Winkel  
    ImgT := Betrag * Sin(Winkel); //Betrag * Sinus Winkel  
  except  
    Result := false;  
    end;  
end; 

//Noch ein Ausschnitt auf der Routine PaintBox1Paint:

      //Raster
      if (rasterx <> 0) and not scalefit then begin
        Pen.Color := rasterxcolor;
        Pen.Width := rasterxstrength;
        Pen.Style := XPenStyle;
        for i := 1 to w div 2 do begin
          if i mod rasterx = 0 then begin
            //+
            MoveTo(w div 2 + i, 0);
            LineTo(w div 2 + i, h);
            //-
            MoveTo(w div 2 - i, 0);
            LineTo(w div 2 - i, h);
            end;
          end;
        end;
      if (rastery <> 0) and not scalefit then begin
        Pen.Color := rasterycolor;
        Pen.Width := rasterystrength;
        Pen.Style := YPenStyle;
        for i := 1 to h div 2 do begin
          if i mod rastery = 0 then begin
            //+
            MoveTo(0, h div 2 + i);
            LineTo(w, h div 2 + i);
            //-
            MoveTo(0, h div 2 - i);
            LineTo(w, h div 2 - i);
            end;
          end;
        end;

      //Skalierungsfaktor (x) bestimmen
      SetLength(tempvars, Length(vars));
      SetLength(tempvars2, Length(vars));
      oldv := 0;
      for i := Low(vars) to High(vars) do begin
        if ListBox2.Checked[i] then begin
          if Grafischaddieren1.Checked then begin
            //Zeiger können möglicherweise aus dem Bild wandern
            oldv := oldv + vars[i].Real; //Alle Werte berücksichtigen
            tempvars[i] := oldv;
          end else begin
            case vars[i].Scale of
              1: tempvars[i] := Abs(vars[i].Real);
              2: tempvars2[i] := Abs(vars[i].Real);
              end;
            end;
          end;
          tempvars[i] := Abs(tempvars[i]);
          tempvars2[i] := Abs(tempvars2[i]);
        end;
      if (Zeichnen1.Checked) then begin
        case loesung.Scale of
          1: begin
               SetLength(tempvars, Length(tempvars) + 1);
               tempvars[High(tempvars)] := Abs(loesung.Real);
             end;
          2: begin
               SetLength(tempvars2, Length(tempvars2) + 1);
               tempvars2[High(tempvars2)] := Abs(loesung.Real);
             end;
          end;
        end;