|
![]() |
|
Registriert seit: 28. Dez 2004 Ort: Salzburg 379 Beiträge |
#1
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 ![]() ![]() 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 ![]() ![]() 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: ![]()
(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. |
![]() |
Registriert seit: 10. Mai 2005 160 Beiträge Delphi 7 Enterprise |
#2
wie umfangreich sind die programme denn(Zeilen) und in welcher sprache sind sie geschreiben(+Version)?
~?&/%§$§%\&?~
8) |
![]() |
Registriert seit: 28. Dez 2004 Ort: Salzburg 379 Beiträge |
#3
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:
Terminplaner dscore.pas:
{************************************}
{* *} {* 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.
Delphi-Quellcode:
Complex Calculator, Ausschnitt aus cmpxmain.pas:
{************************************}
{* *} {* 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.
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;
(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. |
![]() |
Registriert seit: 18. Apr 2004 Ort: Linz 2.044 Beiträge Turbo Delphi für Win32 |
#4
Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht!
![]()
Faux Manuel
Wer weiß, dass er nichts weiß, weiß mehr, als der der nicht weiß, dass er nichts weiß. |
![]() |
Newbie44
(Gast)
n/a Beiträge |
#5
![]() Bei der Deinstallation vom Terminplaner wird das Desktopicon nicht gelöscht!
![]() |
![]() |
Registriert seit: 28. Dez 2004 Ort: Salzburg 379 Beiträge |
#6
Das ist mir gar nicht aufgefallen
![]() Dust Signs
(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. |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |