AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte 2 Projekte abzugeben

2 Projekte abzugeben

Ein Thema von Dust Signs · begonnen am 21. Jul 2005 · letzter Beitrag vom 17. Aug 2005
Antwort Antwort
Dust Signs
Registriert seit: 28. Dez 2004
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
Angehängte Dateien
Dateityp: exe dstp_160_636.exe (479,6 KB, 74x aufgerufen)
(aka AXMD in der EE)
Die Nummer, die Sie gewählt haben, ist imaginär. Bitte drehen Sie Ihr Telefon um 90° und versuchen Sie es erneut.
 
new32

 
Delphi 7 Enterprise
 
#2
  Alt 21. Jul 2005, 16:47
wie umfangreich sind die programme denn(Zeilen) und in welcher sprache sind sie geschreiben(+Version)?
  Mit Zitat antworten Zitat
Dust Signs
 
#3
  Alt 21. Jul 2005, 17:05
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;
  Mit Zitat antworten Zitat
Benutzerbild von faux
faux

 
Turbo Delphi für Win32
 
#4
  Alt 17. Aug 2005, 10:59
Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht!
Faux Manuel
  Mit Zitat antworten Zitat
Newbie44
 
#5
  Alt 17. Aug 2005, 11:08
Zitat von faux:
Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht!
bor wie schlimm, das müssen wir gleich jeden erzählen damit sie es alle wissen.
  Mit Zitat antworten Zitat
Dust Signs
 
#6
  Alt 17. Aug 2005, 16:01
Das ist mir gar nicht aufgefallen Aber das Projekt "Terminplaner" ist bereits vergeben - nur zur Information.

Dust Signs
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:18 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf