Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: reEditor.pas Sprache: Delphi

unit reEditor;

interface

uses reAgenda, Windows, Classes, Graphics, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, SysUtils, Dialogs, ComCtrls, Math;

type
  TEditor = class(TForm)
    OKButton: TButton;
    AbortButton1: TButton;
    ScrollBar1: TScrollBar;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Edit4: TEdit;
    Image1: TImage;
    OpenDialog1: TOpenDialog;
    MonthCalendar1: TMonthCalendar;
    SpeedButton1: TSpeedButton;
    Combo: TComboBox;
    DateForm: TLabel;
    Email: TEdit;
    Label5: TLabel;
    procedure FormShow(Sender: TObject);
    procedure EmailExit(Sender: TObject);
    procedure AbortButton1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure OKButtonClick(Sender: TObject);
    procedure DeleteEvent;
    procedure MergeEvents;
    procedure SortEvents;
    procedure PicChange;
    procedure ass(var a:array of char;v:integer;r:integer);
    procedure move(var a:array of char;S:String);
    procedure pmove(var S:String;a:TAppoint);
    procedure Edit1Save(Sender: TObject);
    procedure Edit2Save(Sender: TObject);
    procedure Edit3Save(Sender: TObject);
    procedure Edit4Save(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure OpenDialog1Close(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure MonthCalendar1DblClick(Sender: TObject);
    procedure MonthCalendar1Exit(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
    DoClose:boolean;
  end;

var
  Editor: TEditor;
  SI : integer;
  d, m, y:integer;
  Eout   : Textfile;   // Achtung: nur Text funktioniert

implementation

{$R *.dfm}

const
  SCopyright     = 'Copyright © 1996, 1998-2002 Borland International';

type
   EFileInvalid = class(Exception);

{------------------------------------------------------------------}
{-   Procedure ass                                                -}
{-   assign                                                       -}
{------------------------------------------------------------------}
procedure TEditor.FormCreate(Sender: TObject);
begin
  SI := 1;
  DoClose:=false;
  ScrollBar1.SetParams(0,0,Math.Max(1,AllCount-1));
  // test for english date format
  if Pos('mm.',LowerCase(ShortDateFormat))=1 then
    DateForm.Caption := '(mm.dd.yyyy)'
  else
    DateForm.Caption := '(dd.mm.yyyy)';
  if Modus in [Aendern, Loeschen] then begin
    if All[SI].Year = '0000' then
      Edit1.Text := All[SI].Day+'.'+All[SI].Month+'.'
    else
      Edit1.Text := All[SI].Day+'.'+All[SI].Month+'.'+All[SI].Year;
    ScrollBar1Change(Sender);
    Edit1.Text := All[SI].Day+'.'+All[SI].Month+'.'+All[SI].Year;
    Edit2.Text := All[SI].Who;
    combo.Text := All[SI].Typ;
    Edit4.Text := All[SI].Wish;
    Email.Text := All[SI].Email;
    PicChange;
    ScrollBar1.Show;
  end
  else begin
    Edit1.clear;
    Edit2.Clear;
    combo.Clear;
    Edit4.Clear;
    Email.clear;
    ScrollBar1.Hide;
  end;
end;

procedure TEditor.FormShow(Sender: TObject);
var i:integer;
begin
  for i:=1 to 32 do
    if Eventtypes[i]>'' then
      Editor.Combo.Items.Add(eventtypes[i]);
  OKButton.Caption := D_OK[Opt.lang];
  AbortButton1.Caption := D_Abbrechen[Opt.lang];
  if Modus=Neu then begin
    Caption        := D_Ereignis[Opt.lang]+' '+D_Neu[Opt.lang];
    OKButton.Caption := D_Neu[Opt.lang];
  end else if Modus=Loeschen then begin
    Caption        := D_Ereignis[Opt.lang]+' '+D_Loeschen[Opt.lang];
    OKButton.Caption := D_Loeschen[Opt.lang]
  end else begin
    Caption        := D_Ereignis[Opt.lang]+' '+D_Aendern[Opt.lang];
    OKButton.Caption := D_Sichern[Opt.lang];
  end;
  Label1.Caption := D_AM[Opt.lang];
  Label2.Caption := D_Hat[Opt.lang];
  Label3.Caption := D_Ereignis[Opt.lang];
  Label4.Caption := '[' + D_UND[Opt.lang] + ']';
  Label5.Caption := '['+D_Email[Opt.lang]+']';
end;

{------------------------------------------------------------------}
{-   Procedure CompEvents                                          -}
{-   for to compress Events                                        -}
{------------------------------------------------------------------}
Procedure TEditor.DeleteEvent;
var i:integer;
begin
   for i:=Si+1 to AllCount do
     All[i-1] := All[i];
   Allcount := AllCount - 1;
end;{GetEvents}

{------------------------------------------------------------------}
{-   Procedure MergeEvents                                          -}
{-   for to merge Events                                        -}
{------------------------------------------------------------------}
Procedure TEditor.MergeEvents;
Var
   i, j, k   : integer;
   S, S1, S2 : String;
   CD, CM    : Char2;
   CY        : Char4;
begin
   //new event to S2
   ass(CD,D,1);
   ass(CM,M,1);
   ass(CY,y,2000);
   S2:=CM+CD;
   for i:=1 to Allcount do begin
      S1:=All[i].Month+All[i].Day;
      if (S1 >= S2) or ((i=AllCount) and not(S2='9999')) then
      begin
         for j:=Allcount+1 downto i+1 do
           All[j] := All[j-1];
         S2 := '9999';
         if i=Allcount then k:=i+1 else k:=i;
         All[k].Month := CM;
         All[k].Day   := CD;
         All[i].BC    := ' ';
         if y < 0 then All[i].BC := '-';
         if y <> 0 then All[k].Year  := CY
         else           All[k].Year := ' ';
         move(All[k].Who,Edit2.Text);
         move(All[k].Typ,Combo.Text);
         move(All[k].Wish,Edit4.Text);
         move(All[k].Email,Email.Text);
         move(All[k].picture,LowerCase(Opendialog1.filename));
         All[k].Remote  := Remotemark;
         All[k].Repeats := Blank28;
         All[k].Done    := Blank4;
         Allcount       := AllCount+1;
         if Allcount > AllCountMax then begin
            S := 'Out of Memory, more than'
                  +InttoStr(AllcountMax)+
                  ' events!';
            raise EFileInvalid.Create(S)
         end;
         SI := 1;
         ScrollBar1.SetParams(0,0,AllCount-1);
      end;
   end;
end;{GetEvents}

{------------------------------------------------------------------}
{-   Procedure SortEvents                                          -}
{-   sort by month/day                                        -}
{------------------------------------------------------------------}
procedure TEditor.SortEvents;
var i,j:integer;
  MX : TAppoint;
begin
   for i:=1 to AllCount do
     for j:=1 to AllCount do
       if All[i].Month + All[i].Day
        < All[j].Month + All[j].Day then
       begin
         MX := All[i];
         All[i] := All[j];
         All[j] := MX
       end;
end;

{------------------------------------------------------------------}
{-   Procedure ass                                                -}
{-   assign                                                       -}
{------------------------------------------------------------------}
procedure TEditor.AbortButton1Click(Sender: TObject);
begin
  DoClose:=true;
  Close;
end;

{------------------------------------------------------------------}
{-   Procedure ass                                                -}
{-   assign                                                       -}
{------------------------------------------------------------------}
procedure TEditor.ass(var a:array of char;v:integer;r:integer);
var d1, d2, d3, d4 : integer;
begin
d3:=0;d4:=0;
if v < 0 then v := -v;
if r>1000 then begin
  d1 := (v div 1000);
  d2 := (v-d1*1000) div 100;
  d3 := (v-d1*1000-d2*100) div 10;
  d4 := (v-d1*1000-d2*100 -d3*10);
end
else begin
  d1 := v div 10;
  d2 := v-d1*10;
end;
if (r>1000) then begin
a[0] := chr(ord('0')+d1);
a[1] := chr(ord('0')+d2);
a[2] := chr(ord('0')+d3);
a[3] := chr(ord('0')+d4);
end
else begin
a[0] := chr(ord('0')+d1);
a[1] := chr(ord('0')+d2);
end;
end;

{-------------------------------------------------------------}
{-   Procedure move und pmove                                -}
{-   move                                                    -}
{-------------------------------------------------------------}
procedure TEditor.move(var a:array of char;S:String);
var i,m,n:integer;
begin
m:=length(S);
n:= length(a);
for i:=0 to n-1 do a[i] := ' ';
if n <= m then m:=n;
for i:=0 to m-1 do
  a[i] := S[i+1];
end;

{------------------------------------------------------------------}
{-   Procedure ass                                                -}
{-   assign                                                       -}
{------------------------------------------------------------------}
procedure TEditor.pmove(var S:String;a:TAppoint);
var i,m,n:integer;p:PChar;
begin
m:=sizeof(S);
n:= sizeof(a);
if m < n then n := m;
p:=@a;
for i:=0 to n-1 do
  S := S + p[i];
end;

procedure TEditor.ScrollBar1Change(Sender: TObject);
begin
  if Modus in [Aendern,Loeschen] then begin
    Si := ScrollBar1.Position+1;
    if All[SI].Year = '0000' then
      Edit1.Text := All[SI].Day+'.'+All[SI].Month+'.'
    else
      Edit1.Text := All[SI].Day+'.'+All[SI].Month+'.'+All[SI].Year;
    Edit2.Text := All[SI].Who;
    combo.Text := All[SI].Typ;
    Edit4.Text := All[SI].Wish;
    Email.Text := All[SI].Email;
    PicChange;
    RePaint;
  end;
end;

procedure TEditor.OKButtonClick(Sender: TObject);
begin
  if Modus = Aendern then begin
    Move(All[SI].Picture, LowerCase(Opendialog1.FileName));
    SortEvents;
  end
  else if Modus = Loeschen then
    DeleteEvent
  else if Modus = Neu then begin
    Move(All[SI].Picture, LowerCase(Opendialog1.FileName));
    MergeEvents;
    SortEvents;
  end;
end;

procedure TEditor.Edit1Save(Sender: TObject);
const
  Seps = ['.','/','-'];
var i,ex :integer;
    S : String;
    FirstCentury:boolean;
    BeforeChrist:boolean;
begin
  S:= ' '; d:=0;m:=0;y:=0;
  if Edit1.Text='' then
    Edit1.Text:=' ';
  Edit1.text := Edit1.Text + ' ';
  i:=1;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i]; i:=i+1; end;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i]; i:=i+1; end;
  if S > '' then TryStrToInt(S,d);
  if Edit1.Text[i] in Seps then i:=i+1;
  S:='';
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i]; i:=i+1; end;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i]; i:=i+1 end;
  if S > '' then TryStrToInt(S,m);
  // test for english date format
  if Pos('m',LowerCase(ShortDateFormat))=1 then begin
    ex := d;
    d := m;
    m := ex;
  end;

  if (Edit1.Text[i] in Seps) and (Length(Edit1.Text)>i) then i:=i+1;
  S:='';FirstCentury:=false;BeforeChrist := false;
  //check for the year 0037
  if  (Edit1.Text[i]  = '-') then begin
    BeforeChrist := true;
    i := i+1;
  end;
  //check for the year 0037
  if  (Edit1.Text[i]  in ['0'..'9']) then begin
    FirstCentury:=(Edit1.Text[i]='0') and (Edit1.Text[i+1]='0');
    S:= S+Edit1.Text[i]; i:=i+1;
  end;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i]; i:=i+1; end;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i];  i:=i+1; end;
  if Edit1.Text[i] in ['0'..'9'] then
    begin S:= S+Edit1.Text[i] end;
  if S > '' then TryStrToInt(S,y);

  // date abbreviations
  if (Modus=Neu) and (y<>0) then begin
    if not BeforeChrist then  begin
      if Not FirstCentury and ((y>20) and (y<100)) then y:=1900+y
      else if Not FirstCentury and (y<=20) then y:=2000+y
    end else begin
      y := -y
    end
  end;

  if Modus = Aendern then begin
    if (d>0) and (d<=31)  then ass(All[SI].Day,d,10);
    if (m>0) and (m<=12)  then ass(All[SI].Month,m,10);
    if Not BeforeChrist  then begin
      All[SI].BC := ' ';
      if (y>0) and (y<3000) then ass(All[SI].Year,y,2000)
    end else begin
      All[SI].BC := '-';
      ass(All[SI].Year,y,2000);
    end
   end;

end;

procedure TEditor.Edit2Save(Sender: TObject);
begin
  if Modus = Aendern then
    Move(All[SI].Who, Trim(Edit2.Text));
end;

procedure TEditor.Edit3Save(Sender: TObject);
begin
  if Modus = Aendern then
     Move(All[SI].Typ, Trim(combo.Text));
end;

procedure TEditor.Edit4Save(Sender: TObject);
begin
  if Modus = Aendern then
     Move(All[SI].Wish, Trim(Edit4.Text));
end;

procedure TEditor.EmailExit(Sender: TObject);
begin
  if Modus = Aendern then  begin
     if Trim(Email.Text)<>Trim(All[SI].email) then
       Move(All[SI].Done, Blank4);
     Move(All[SI].Email, Trim(Email.Text));
  end;
end;

procedure TEditor.OpenDialog1Close(Sender: TObject);
begin
  if Modus = Aendern then
     Move(All[SI].Picture, LowerCase(Opendialog1.FileName));
end;

procedure TEditor.Image1Click(Sender: TObject);
var S:String;
begin
   OpenDialog1.Execute;
   S:= LowerCase(Trim(OpenDialog1.FileName));
   if S <> '' then begin
     Image1.Picture.LoadFromFile(S);
     StrPCopy(@All[SI].Picture,S);
     opendialog1.InitialDir:=ExtractFilePath(S)
   end
end;

procedure TEditor.PicChange;
var S:String;
begin
    if FileExists(All[SI].Picture) then begin
      S:=Trim(All[SI].Picture);
      Image1.Picture.LoadFromFile(S);
      Opendialog1.InitialDir:=ExtractFilePath(S);
    end else begin
      All[SI].Picture:='';
      S:= Opt.ProgramDir+ImageDir+'\'+'McIlroy.bmp';
      if FileExists(S) then
       Image1.Picture.LoadFromFile(S);
      Image1.Picture.Bitmap.FreeImage
    end;
end;

procedure TEditor.SpeedButton1Click(Sender: TObject);
begin
   MonthCalendar1.Visible:=true;
   MonthCalendar1.Show;
end;

procedure TEditor.MonthCalendar1DblClick(Sender: TObject);
begin
   monthcalendar1.Visible:=false;
   edit1.Text := datetostr(MonthCalendar1.Date);
   edit2.SetFocus;
end;

procedure TEditor.MonthCalendar1Exit(Sender: TObject);
begin
   monthcalendar1.Visible:=false;
   edit1.Text := datetostr(MonthCalendar1.Date);
   edit2.SetFocus;
end;

procedure TEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if not DoClose then begin
  if (Edit1.Text='') or (Edit2.Text='') or (Combo.Text='')then
   CanClose := false
  else CanClose := true;
  end else
    CanClose:=true;

end;

end.

¤ Dauer der Verarbeitung: 0.22 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.