2 Projekte abzugeben

[Dust Signs]

N'Abend!

Hab vor ca. einem halben Jahr ein Projekt niedergelegt und dachte mir jetzt, dass sich vielleicht jemand finden würde, der es fortführt und eventuell verbessert. Ich habe weder Zeit noch Lust - vielleicht ja jemand anders hier ;). Konkret geht es um 2 Projekte - das eine ist mein alter Terminplaner (DSTP 1.6 - Programm zu finden im Anhang) und mein Complex Calculator.
Ich gebe die Sourcen komplett her und erhebe auch keinerlei Anspruch auf Einsicht der Sourcen nach der Weiterführung. Doch wie bei jeder Sache gibt's auch hier einen Haken - es gibt genauer gesagt sogar 2 ;). Zum einen müssen beide Projekte Freeware bleiben (und zwar komplett; eine Shareware- und eine Freeware-Version zu erstellen gilt beispielsweise nicht ;)). Der zweite Haken betrifft prinzipiell nur den Terminplaner: der Quelltext ist kaum kommentiert und äußerst umfangreich. Complex Calculator ist hingegen ausführlich kommentiert.
Kleiner Hinweis @BenBE: je nach dem, wie es mit deinem Einverständnis aussieht, werde ich deine modifizierte oder meine originale Version der Sourcen hergeben.
Diesen Thread sehe ich als Chance für all diejenigen, die diese Projekte gerne fortführen möchten. "Bewerbt" euch einfach darum, wenn ihr Lust habt - bitte mit einer Begründung und eventuellen Vorhaben damit ich mich besser entscheiden kann, falls es mehrere Interessenten gibt.

Danke :)
Dust Signs

//EDIT: Crosspost DF: http://www.delphi-forum.de/viewtopic...4da97bad32b883

[new32]

wie umfangreich sind die programme denn(Zeilen) und in welcher sprache sind sie geschreiben(+Version)?

[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;

[faux]

Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht! :warn:

[Newbie44]

Zitat:

Zitat von faux

Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht! :warn:

bor wie schlimm, das müssen wir gleich jeden erzählen damit sie es alle wissen.

[Dust Signs]

Das ist mir gar nicht aufgefallen :oops: Aber das Projekt "Terminplaner" ist bereits vergeben - nur zur Information.

Dust Signs