Procedure aus Form1 im Form3 nutzen?

[OrNEC]

Unit1

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, Menus, ActnList, StdActns, ComCtrls,
  XPMan, ImgList, ToolWin, Buttons, IniFiles, Shellapi;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Info1: TMenuItem;
    Neu1: TMenuItem;
    StatusBar1: TStatusBar;
    XPManifest1: TXPManifest;
    Beenden1: TMenuItem;
    ToolBar1: TToolBar;
    Bearbeiten1: TMenuItem;
    Info2: TMenuItem;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    N1: TMenuItem;
    Speichern1: TMenuItem;
    Neualt1: TMenuItem;
    Datensatzndern1: TMenuItem;
    Hilfe1: TMenuItem;
    ToolButton8: TToolButton;
    PopupMenu1: TPopupMenu;
    ndern1: TMenuItem;
    Lschen2: TMenuItem;
    Neu2: TMenuItem;
    Neufortlaufend1: TMenuItem;
    N4: TMenuItem;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    WebseiteBesuchen1: TMenuItem;
    N5: TMenuItem;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure Info2Click(Sender: TObject);
    procedure ToolButton6Click(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure Hilfe1Click(Sender: TObject);
    procedure Neu1Click(Sender: TObject);
    procedure Neualt1Click(Sender: TObject);
    procedure Speichern1Click(Sender: TObject);
    procedure Datensatzndern1Click(Sender: TObject);
    procedure Lschen1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ToolButton9Click(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure WebseiteBesuchen1Click(Sender: TObject);
    procedure ToolButton12Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure ZeileBlenden(sg: TStringgrid; Zeile: integer);
  end;

type typ_datensatz = RECORD
                  nummer: Integer;
                  medium: String[50];
                  name: String[40];
                  kategorie: String[20];
                  telefon: String[20];
end;
type TDatum = RECORD
                  asldatum: String;
                  ruckdatum: String;
end;

var
  Form1: TForm1;
  index           :Array[1..1000] of typ_datensatz;
  datum           :Array[1..1000] of TDatum;
  nummer          :Integer;
  datei           :File of typ_datensatz;
  i,a,b,c,d,e,f               :Integer;
  aenderprf       :Boolean;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure  gridspeichern(grd:TStringGrid;Datei:string);
var sl:TStringlist;
x,y:integer;
begin
sl:=TStringlist.create;
sl.add(inttostr(grd.colcount));
sl.add(inttostr(grd.rowcount));
for x:=0 to grd.ColCount-1 do
for y:=0 to grd.RowCount-1 do
sl.add(grd.cells[x,y]);
for x:=0 to grd.ColCount-1 do
sl.add(inttostr(grd.ColWidths[x]));
for x:=0 to grd.RowCount-1 do
sl.add(inttostr(grd.RowHeights[x]));
sl.add(inttostr(grd.clientwidth));
sl.add(inttostr(grd.clientheight));
sl.add(inttostr(ord(grd.ScrollBars)));
sl.savetofile(datei);
sl.free;
end;

procedure gridladen(grd:TStringGrid;Datei:string;angleichen:boolean);
var sl:TStringlist;
x,y,z:integer;
begin
sl:=TStringlist.create;
sl.loadfromfile(datei);
grd.colcount:=strtoint(sl.strings[0]);
grd.rowcount:=strtoint(sl.strings[1]);
z:=2;
for x:=0 to grd.ColCount-1 do
for y:=0 to grd.RowCount-1 do begin
grd.cells[x,y]:=sl.strings[z];
inc(z);
end;
if angleichen then begin
for x:=0 to grd.ColCount-1 do begin
grd.ColWidths[x]:=strtoint(sl.strings[z]);
inc(z);
end;
for x:=0 to grd.RowCount-1 do begin
grd.RowHeights[x]:=strtoint(sl.strings[z]);
inc(z);
end;
grd.clientwidth:=strtoint(sl.strings[z]);
grd.clientheight:=strtoint(sl.strings[z+1]);
grd.ScrollBars:=TScrollStyle(strtoint(sl.strings[z+2]));
end;
sl.free;
end;

// Zeilen ein- und ausblenden
procedure ZeileBlenden(sg: TStringgrid; Zeile: integer);
begin
  if (Zeile < sg.rowcount) and (Zeile >= 0)
    then begin
    if sg.rowheights[Zeile] <= abs(sg.GridlineWidth) then
      sg.rowheights[Zeile] := sg.DefaultRowHeight
    else sg.rowheights[Zeile] := -sg.GridlineWidth;
  end;
end;

// Zeilen löschen
procedure GridDeleteRow(const Grid : TStringGrid; RowNumber : Integer);
var
i : Integer;
begin
  for i := RowNumber to Grid.RowCount - 2 do
    Grid.Rows[i].Assign(Grid.Rows[i+ 1]);
  Grid.Rows[Grid.RowCount-1].Clear;
  Grid.RowCount := Grid.RowCount - 1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
 Ini: TIniFile;
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'Config.ini');
 try
   WindowState := TWindowState(Ini.ReadInteger('Default', 'WindowState', 0));
 finally
   Ini.Free;
 end;

aenderprf:=False;
// Titelzeile erstellen
StringGrid1.ColWidths[0]:=25;
StringGrid1.ColWidths[1]:=220;
StringGrid1.ColWidths[2]:=130;
StringGrid1.ColWidths[3]:=150;
StringGrid1.ColWidths[4]:=110;
StringGrid1.ColWidths[5]:=100;
StringGrid1.ColWidths[6]:=150;
Stringgrid1.cells[0,0]:='';
Stringgrid1.cells[1,0]:='Titel (Autor), Gegenstand';
Stringgrid1.cells[2,0]:='Kategorie';
Stringgrid1.cells[3,0]:='Name, Vorname';
Stringgrid1.cells[4,0]:='Telefon';
Stringgrid1.cells[5,0]:='Geliehen am';
Stringgrid1.cells[6,0]:='';

// Letzte Zeile ausblenden
ZeileBlenden(StringGrid1, Stringgrid1.rowcount-1);

if FileExists('db.lhh') then
begin
gridladen(StringGrid1,'db.lhh',true);
end else MessageDlg('Die Datei "db.lhh" konnte nicht gefunden werden!' + CHR(13)
+ 'Das Programm wird nach dem Speichern eine neue erstellen.', mtWarning,[mbOK],0);

if Stringgrid1.rowcount=2 then ToolButton2.Enabled:=False;

if StringGrid1.RowCount=3 then
begin
StatusBar1.Panels[0].Text:=('1 Eintrag');
end else
begin
StatusBar1.Panels[0].Text:=FloatToStr(Stringgrid1.RowCount-2)+ ' Einträge';
end;

a:=StringGrid1.ColWidths[0];
b:=StringGrid1.ColWidths[1];
c:=StringGrid1.ColWidths[2];
d:=StringGrid1.ColWidths[3];
e:=StringGrid1.ColWidths[4];
f:=StringGrid1.ColWidths[5];

StringGrid1.Row:=StringGrid1.RowCount-1;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
var n: Integer;
begin
if Form3.GroupBox1.Visible=False then
begin
  if (StringGrid1.Row>-1) and (StringGrid1.Row<StringGrid1.RowCount-1) then
  begin
      if Application.MessageBox('Möchten Sie wirklich diesen Eintrag löschen?','Löschen bestätigen',36)=6 then
      begin
      GridDeleteRow(StringGrid1, StringGrid1.Row);
      StringGrid1.Row:=StringGrid1.RowCount-1;
            for n := 1 to StringGrid1.RowCount - 1 do
            begin
            StringGrid1.Cells[0,n]:=IntToStr(n);
            end;
      ZeileBlenden(StringGrid1, Stringgrid1.rowcount-1);
      if Stringgrid1.rowcount=2 then
          begin
          ToolButton2.Enabled:=False;
          end;
                  if StringGrid1.RowCount=3 then
                  begin
                  StatusBar1.Panels[0].Text:=('1 Eintrag');
                  end else
                      begin
                      StatusBar1.Panels[0].Text:=FloatToStr(Stringgrid1.RowCount-2)+ ' Einträge';
                      end;
      aenderprf:=True;
      ToolButton4.Enabled:=True;
      end;
  end else Application.MessageBox('Löschen nicht möglich, bitte erst einen Eintrag auswählen!','Fehler',16);
end else Application.MessageBox('Löschen nicht möglich!','Fehler',16);
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
Form3.ShowModal;
//StringGrid1.Row:=StringGrid1.RowCount-1;      ???
Form3.DateTimePicker1.Date:=Now;
Form3.GroupBox1.Caption:='Neuen Eintrag einfügen';
Form3.Edit1.Text:='';
Form3.Edit2.Text:='';
Form3.Edit3.Text:='';
Form3.ComboBox1.Text:='';
Form3.Edit2.SetFocus;
Form3.BitBtn1.Visible:=True;
Form3.BitBtn3.Visible:=False;
Form3.BitBtn2.Enabled:=True;
end;

procedure TForm1.ToolButton2Click(Sender: TObject);
begin
if Stringgrid1.rowcount>2 then
begin
Form3.ShowModal;
StringGrid1.Row:=StringGrid1.RowCount-1;
Form3.DateTimePicker1.Date:=Now;
Form3.GroupBox1.Caption:='Neuen Eintrag einfügen';
Form3.BitBtn1.Visible:=True;
Form3.BitBtn3.Visible:=False;
Form3.BitBtn2.Enabled:=True;

i:=Stringgrid1.rowcount-2;
index[i].kategorie:=Stringgrid1.cells[2,i];
index[i].name:=Stringgrid1.cells[3,i];
index[i].telefon:=Stringgrid1.cells[4,i];

Form3.Edit2.Text:=index[i].name;
Form3.ComboBox1.Text:=index[i].kategorie;
Form3.Edit3.Text:=index[i].telefon;

Form3.Edit1.SetFocus;
end else Application.MessageBox('Diese Funktion steht erst ab den ersten Eintag zur Verfügung!','Fehler',16);
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
gridspeichern(StringGrid1,'db.lhh');
ToolButton4.Enabled:=False;
aenderprf:=False;
end;

procedure TForm1.Info2Click(Sender: TObject);
begin
AboutBox.Show;
end;

procedure TForm1.ToolButton6Click(Sender: TObject);
begin
if (StringGrid1.Row>-1) and (StringGrid1.Row<StringGrid1.RowCount-1) then
begin
Form3.ShowModal;
Form3.GroupBox1.Caption:='Eintrag editieren';

Form3.BitBtn1.Visible:=False;
Form3.BitBtn3.Visible:=True;
Form3.BitBtn2.Enabled:=True;

Form3.Edit2.SetFocus;

i:=Stringgrid1.row;
index[i].medium:=StringGrid1.Cells[1,i];
index[i].kategorie:=Stringgrid1.cells[2,i];
index[i].name:=Stringgrid1.cells[3,i];
index[i].telefon:=Stringgrid1.cells[4,i];
datum[i].asldatum:=Stringgrid1.cells[5,i];

Form3.Edit1.Text:=index[i].medium;
Form3.Edit2.Text:=index[i].name;
Form3.ComboBox1.Text:=index[i].kategorie;
Form3.Edit3.Text:=index[i].telefon;
Form3.DateTimePicker1.Date:=StrToDate(datum[i].asldatum);
end else Application.MessageBox('Editieren nicht möglich, bitte erst einen Eintrag auswählen!','Fehler',16);
end;

procedure TForm1.ToolButton8Click(Sender: TObject);
begin
ShowMessage('Die Hilfe steht noch nicht zur Verfügung!');
end;

procedure TForm1.Hilfe1Click(Sender: TObject);
begin
ToolButton8Click(Sender);
end;

procedure TForm1.Neu1Click(Sender: TObject);
begin
ToolButton1Click(Sender);
end;

procedure TForm1.Neualt1Click(Sender: TObject);
begin
ToolButton2Click(Sender);
end;

procedure TForm1.Speichern1Click(Sender: TObject);
begin
ToolButton4Click(Sender);
end;

procedure TForm1.Datensatzndern1Click(Sender: TObject);
begin
ToolButton6Click(Sender);
end;

procedure TForm1.Lschen1Click(Sender: TObject);
begin
ToolButton7Click(Sender);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin

if (StringGrid1.ColWidths[0]<>a) or (StringGrid1.ColWidths[1]<>b) or (StringGrid1.ColWidths[2]<>c) or (StringGrid1.ColWidths[3]<>d) or (StringGrid1.ColWidths[4]<>e) or (StringGrid1.ColWidths[5]<>f) then
begin
    aenderprf:=True;
end;

if aenderprf=True then
  begin
      case MessageDlg('Möchten Sie die Änderungen speichern?', mtConfirmation,
      [mbYes, mbNo, mbCancel], 0) of
      idYes: ToolButton4Click(Sender);
      idCancel: CanClose := False
      end
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
 Ini: TIniFile;
begin
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'Config.ini');
 try
   Ini.WriteInteger('Default', 'WindowState', Ord(WindowState));
 finally
   Ini.Free;
 end;
Action:=caFree;
end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
AboutBox.Show;
end;

procedure TForm1.ToolButton10Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in ['0'..'9','-', '(', ')', '+', Char(VK_BACK)]) then
  Key:=#0;
end;

procedure TForm1.ToolButton12Click(Sender: TObject);
begin
ShellExecute(Application.Handle, 'open', PChar('http://www.ornec.de'), nil, nil, 0);
end;

procedure TForm1.WebseiteBesuchen1Click(Sender: TObject);
begin
ToolButton12Click(Sender);
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var iTage: Integer;
begin
    with StringGrid1 do
      // auf Acol muss nicht reagiert werden = komplette Zeile färben
      if ARow in [FixedRows..RowCount-2] then //nur die Zeilen färben
      begin
      iTage:=Round(Trunc(now) - StrToDate(Cells[5, ARow]));
         if (iTage>=14) and (iTage<28) then
         begin
         Canvas.Brush.Color:=RGB(176,176,255); //Hintergrundfarbe - Blau
         end else if (iTage>=28) then
             begin
             Canvas.Brush.Color:=RGB(255,106,106); //Hintergrundfarbe - Rot
             end;
     Canvas.FillRect(Rect);
     Canvas.TextOut(Rect.Left+2, Rect.Top+2, Cells[ACol, ARow]);
     end;

end;

end.

Unit3

Delphi-Quellcode:

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons;

type
  TForm3 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    ComboBox1: TComboBox;
    DateTimePicker1: TDateTimePicker;
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

uses Unit1;

{$R *.dfm}

// Zeilen ein- und ausblenden
procedure ZeileBlenden(sg: TStringgrid; Zeile: integer);
begin
  if (Zeile < sg.rowcount) and (Zeile >= 0)
    then begin
    if sg.rowheights[Zeile] <= abs(sg.GridlineWidth) then
      sg.rowheights[Zeile] := sg.DefaultRowHeight
    else sg.rowheights[Zeile] := -sg.GridlineWidth;
  end;
end;

procedure TForm3.BitBtn1Click(Sender: TObject);
begin
if Form3.Edit2.Text='' then
begin
Application.MessageBox('Bitte den Namen eintragen!','Fehler',16);
Form3.Edit2.SetFocus;
Exit;
end;

if Form3.Edit1.Text='' then
begin
Application.MessageBox('Bitte den Titel eintragen!','Fehler',16);
Form3.Edit1.SetFocus;
Exit;
end;

// Letzte Zeile einblenden
ZeileBlenden(Form1.StringGrid1, Form1.StringGrid1.RowCount-1);    ???

i:=Form1.Stringgrid1.rowcount-2;
i:=i+1;
index[i].medium:=Form3.Edit1.Text;
index[i].name:=Form3.Edit2.Text;
index[i].kategorie:=Form3.ComboBox1.Text;
index[i].telefon:=Form3.Edit3.Text;
datum[i].asldatum:=DateToStr(Form3.DateTimePicker1.Date);

nummer:=Form1.Stringgrid1.rowcount-2;
nummer:=nummer+1;
index[i].nummer:=nummer;
Form1.Stringgrid1.rowcount:=Form1.Stringgrid1.rowcount+1;

Form1.Stringgrid1.cells[0,i] := IntToStr(index[i].nummer);
Form1.Stringgrid1.cells[1,i] := index[i].medium;
Form1.Stringgrid1.cells[2,i] := index[i].kategorie;
Form1.Stringgrid1.cells[3,i] := index[i].name;
Form1.Stringgrid1.cells[4,i] := index[i].telefon;
Form1.Stringgrid1.cells[5,i] := datum[i].asldatum;

// Letzte Zeile ausblenden
//ZeileBlenden(StringGrid1, Stringgrid1.rowcount-1);   ???

Form3.Edit1.Text:='';
Form3.Edit2.Text:='';
Form3.Edit3.Text:='';
//Form3.GroupBox1.Visible:=False;      ???
Form1.ToolButton2.Enabled:=True;
if Form1.Stringgrid1.rowcount=2 then Form1.ToolButton2.Enabled:=False;

if Form1.StringGrid1.RowCount=3 then
begin
Form1.StatusBar1.Panels[0].Text:=('1 Eintrag');
end else
begin
Form1.StatusBar1.Panels[0].Text:=FloatToStr(Form1.Stringgrid1.RowCount-2)+ ' Einträge';
end;
aenderprf:=True;
Form1.ToolButton4.Enabled:=True;
Form1.StringGrid1.Row:=Form1.StringGrid1.RowCount-1;
end;

procedure TForm3.BitBtn2Click(Sender: TObject);
begin
//Form3.GroupBox1.Visible:=False;  ???
Form3.Edit1.Text:='';
Form3.Edit2.Text:='';
Form3.Edit3.Text:='';
end;

procedure TForm3.BitBtn3Click(Sender: TObject);
begin
if Form3.Edit2.Text='' then
begin
Application.MessageBox('Bitte den Namen eintragen!','Fehler',16);
Form3.Edit2.SetFocus;
Exit;
end;

if Form3.Edit1.Text='' then
begin
Application.MessageBox('Bitte das Medium eintragen!','Fehler',16);
Form3.Edit1.SetFocus;
Exit;
end;

i:=Form1.Stringgrid1.row-1;
i:=i+1;
index[i].medium:=Form3.Edit1.Text;
index[i].kategorie:=Form3.ComboBox1.Text;
index[i].name:=Form3.Edit2.Text;
index[i].telefon:=Form3.Edit3.Text;
datum[i].asldatum:=DateToStr(Form3.DateTimePicker1.Date);

Form1.Stringgrid1.cells[1,i] := index[i].medium;
Form1.Stringgrid1.cells[2,i] := index[i].kategorie;
Form1.Stringgrid1.cells[3,i] := index[i].name;
Form1.Stringgrid1.cells[4,i] := index[i].telefon;
Form1.Stringgrid1.cells[5,i] := datum[i].asldatum;

Form3.Edit1.Text:='';
Form3.Edit2.Text:='';
Form3.Edit3.Text:='';

//Form3.GroupBox1.Visible:=False;  ???
aenderprf:=True;
Form1.ToolButton4.Enabled:=True;
end;

end.

[OrNEC]

Hab den Fehler gefunden, die uses Grids hat gefählt, jetzt läuft alles. :thumb:

[DeddyH]

Entweder eine Methode von Form1 (steht da ja schon unter public), dann muss es aber auch

Delphi-Quellcode:

procedure TForm1.ZeileBlenden

heißen, oder aber als reguläre Prozedur, dann musst Du nur deren Prototyp (also den Prozedurkopf) im interface-Abschnitt bekannt machen.