|
![]() |
Registriert seit: 6. Nov 2009 493 Beiträge FreePascal / Lazarus |
#11
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. |
![]() |
Registriert seit: 6. Nov 2009 493 Beiträge FreePascal / Lazarus |
#12
Hab den Fehler gefunden, die uses Grids hat gefählt, jetzt läuft alles.
![]() |
![]() |
Registriert seit: 17. Sep 2006 Ort: Barchfeld 27.588 Beiträge Delphi 12 Athens |
#13
Entweder eine Methode von Form1 (steht da ja schon unter public), dann muss es aber auch
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.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein) Dieser Tag ist längst gekommen |
![]() |
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 |
![]() |
![]() |