Kalender skal hente info fra database

Nu er det ikke en kodecentral hvor der stilles ønsker i stil med giro413. Det må antages at spørgerne er delvist selvhjulpne, dvs. i stand til at lave noget kode selv når de har fået nogle ideer fra os andre.

Jeg ville nok lave en ny komponent der nedarver fra en TDrawgrid og der indkapsle en TQuery/TADOQuery eller hvad de nu hedder. Rimeligt low-tech. Der ville jeg så tegne hvert felt selv så jeg kunne placere grafik og n-antal linier selv. Du skriver "opdaterer løbende", tænker du på en TTimer eller er det en ”data-aware” tingest du vil have fat i?

hehe, nu sad jeg og arbejdede på det i går og fik noget fungerende kode lavet, men hvis jeg forstår data-aware udtrykket rigtigt, så betyder det at der bliver opdateret lige så snart der kommer et nyt post til databasen.
Hvis ikke hvad mener du så med data-aware ?

Måske jeg tager fejl af det du ønsker ?.Lyder lidt som en 'dato-picker' du er ude efter.Har aldrig selv forstået koden til nedenstående eks., der såvidt jeg husker er lavet af Snowball.Men måske kan du få lidt ud af at kigge på hans kode, som jeg har gemt omhyggeligt.Kan se på det gamle spm. at zip-koden er taget ned - desværre.

unit wwwunit3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Db, ADODB, Buttons, Grids, DBCtrls, ExtCtrls, Mask,
  printers;

type
  TFMain = class(TForm)
    ADOConnection1: TADOConnection;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    EForfatter: TEdit;
    EOverskrift: TEdit;
    EResume: TEdit;
    DTPDato: TDateTimePicker;
    MArtikel: TMemo;
    BitBtn1: TBitBtn;
    GroupBox2: TGroupBox;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ESoegForfatter: TEdit;
    ESoegOverskrift: TEdit;
    ESoegResume: TEdit;
    DTPSoegDato: TDateTimePicker;
    BitBtn2: TBitBtn;
    CBAlleDatoer: TCheckBox;
    GroupBox3: TGroupBox;
    SGResultat: TStringGrid;
    MSoegArtikel: TMemo;
    Label10: TLabel;
    Label11: TLabel;
    ESoegArtikel: TEdit;
    Button1: TButton;
    TabSheet3: TTabSheet;
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    Button2: TButton;
    ADODataSet1: TADODataSet;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    ADOCommand1: TADOCommand;
    DataSource1: TDataSource;
    ListBox4: TListBox;
    DBMemo1: TDBMemo;
    DataSource2: TDataSource;
    ADOTable1: TADOTable;
    DBNavigator1: TDBNavigator;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    ListBox5: TListBox;
    Button3: TButton;
    ADOTable2: TADOTable;
    DataSource3: TDataSource;
    DBMemo2: TDBMemo;
    Label19: TLabel;
    Label20: TLabel;
    Bevel1: TBevel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    SaveDialog1: TSaveDialog;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure PageControl1Change(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure SGResultatClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox5Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure printmemo1Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
  valgt: Integer;
    procedure InitGrid;
    function KonverterDato(pDato: String):String;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FMain: TFMain;

implementation

{$R *.DFM}

procedure TFMain.InitGrid;
const
  SGColWidthArray : array[0..3] of integer = (140,160,350,70);
  SGTextArray : array[0..3] of string = ('Forfatter','Overskrift','Resume','Dato');
var
  i: Integer;
begin
  for i := 0 to 3 do begin
    SGResultat.ColWidths[i] := SGColWidthArray[i];
    SGResultat.Cells[i,0] := SGTextArray[i];
  end;
  SGResultat.RowCount := 2;
end;

function TFMain.KonverterDato(pDato: String):String;
begin
  Result := Copy(pDato,4,2) + '-' + Copy(pDato,1,2) + '-' + Copy(pDato,7,4);
end;

procedure TFMain.PageControl1Change(Sender: TObject);
begin
  If PageControl1.ActivePageIndex = 1 Then
    InitGrid;
    If PageControl1.ActivePageIndex = 3 Then
begin
ADODataSet1.Close;
  ADODataSet1.CommandText := 'SELECT * FROM tbl_Artikler';
  ADODataSet1.Open;

  ListBox1.Items.clear;
    ListBox2.Items.clear;
    ListBox3.Items.clear;
      ListBox4.Items.clear;
  while not adodataset1.Eof do begin

ListBox1.Items.Add(adodataset1.FieldByName('forfatter').AsString);
ListBox2.Items.Add(adodataset1.FieldByName('overskrift').AsString);
ListBox3.Items.Add(adodataset1.FieldByName('artikel').AsString);
  ListBox4.Items.Add(adodataset1.FieldByName('resume').AsString);



    adodataset1.Next end;
end;
end;

procedure TFMain.BitBtn1Click(Sender: TObject);
var
  Q1: TADOCommand;
  Success: Boolean;
begin
  Success := True;
  Try
    Q1 := TADOCommand.Create(self);
    Q1.Connection := ADOConnection1;
    Q1.CommandText := 'INSERT INTO tbl_Artikler ' +
                      '(Forfatter, Overskrift, Resume, Dato, Artikel) ' +
                      'VALUES (:pForfatter, :pOverskrift, :pResume, :pDato, :pArtikel)';
    Q1.Parameters.ParamByName('pForfatter').Value := EForfatter.Text;
    Q1.Parameters.ParamByName('pOverskrift').Value := EOverskrift.Text;
    Q1.Parameters.ParamByName('pResume').Value := EResume.Text;
    Q1.Parameters.ParamByName('pDato').Value := DateToStr(DTPDato.Date);
    Q1.Parameters.ParamByName('pArtikel').Value := MArtikel.Lines.Text;
    Q1.CommandType := cmdText;
    Q1.Execute;
    Q1.Free;
  Except
    Q1.Free;
    Success := False;
    Showmessage('Noget gik galt');
  End;
  If Success Then
    Showmessage('Artikel blev gemt i databasen');
end;

procedure TFMain.BitBtn2Click(Sender: TObject);
var
  D1: TADODataSet;
  I: Integer;
begin
  D1 := TADODataSet.Create(self);
  D1.Connection := ADOConnection1;
  D1.Close;
  If CBAlleDatoer.Checked Then
    D1.CommandText := 'Select * FROM tbl_Artikler ' +
                      'WHERE Forfatter LIKE :pForfatter AND Overskrift LIKE :pOverskrift ' +
                      'AND [Resume] LIKE :pResume AND (Dato BETWEEN #01-01-1900# AND #31-12-2999#) ' +
                      'AND Artikel LIKE :pArtikel'
  Else Begin
    D1.CommandText := 'Select * FROM tbl_Artikler ' +
                      'WHERE Forfatter LIKE :pForfatter AND Overskrift LIKE :pOverskrift ' +
                      'AND [Resume] LIKE :pResume AND Dato = #' + KonverterDato(DateToStr(DTPSoegDato.Date)) + '#' +
                      'AND Artikel LIKE :pArtikel';
  End;
  D1.Parameters.ParamByName('pForfatter').Value := '%' + ESoegForfatter.Text + '%';
  D1.Parameters.ParamByName('pOverskrift').Value := '%' + ESoegOverskrift.Text + '%';
  D1.Parameters.ParamByName('pResume').Value := '%' + ESoegResume.Text + '%';
  D1.Parameters.ParamByName('pArtikel').Value := '%' + ESoegArtikel.Text + '%';
  D1.CommandType := cmdText;
  D1.Open;
  If D1.RecordCount > 0 Then
    SGResultat.RowCount := D1.RecordCount + 1
  Else
    SGResultat.RowCount := 2;
  For I := 1 To D1.RecordCount Do Begin
    SGResultat.Cells[0,i] := D1.FieldByName('Forfatter').AsString;
    SGResultat.Cells[1,i] := D1.FieldByName('Overskrift').AsString;
    SGResultat.Cells[2,i] := D1.FieldByName('Resume').AsString;
    SGResultat.Cells[3,i] := D1.FieldByName('Dato').AsString;
    D1.Next;
  End;
  D1.Free;
end;

procedure TFMain.SGResultatClick(Sender: TObject);
var
  D1: TADODataSet;
begin
  D1 := TADODataSet.Create(self);
  D1.Connection := ADOConnection1;
  D1.Close;
  D1.CommandText := 'Select * FROM tbl_Artikler ' +
                    'WHERE Forfatter = :pForfatter AND Overskrift = :pOverskrift ' +
                    'AND [Resume] = :pResume AND Dato = #' + KonverterDato(SGResultat.Cells[3,SGResultat.Row]) + '#';
  D1.Parameters.ParamByName('pForfatter').Value := SGResultat.Cells[0,SGResultat.Row];
  D1.Parameters.ParamByName('pOverskrift').Value := SGResultat.Cells[1,SGResultat.Row];
  D1.Parameters.ParamByName('pResume').Value := SGResultat.Cells[2,SGResultat.Row];
  D1.CommandType := cmdText;
  D1.Open;
  If D1.RecordCount = 1 Then Begin
    MSoegArtikel.Clear;
    MSoegArtikel.Lines.Add('Forfatter: ' + D1.FieldByName('Forfatter').AsString);
    MSoegArtikel.Lines.Add('Overskrift: ' + D1.FieldByName('Overskrift').AsString);
    MSoegArtikel.Lines.Add('Resume: ' + D1.FieldByName('Resume').AsString);
    MSoegArtikel.Lines.Add('Dato: ' + D1.FieldByName('Dato').AsString);
    MSoegArtikel.Lines.Add(' ');
    MSoegArtikel.Lines.Add(D1.FieldByName('Artikel').AsString);
  End;
  D1.Free;
end;

procedure TFMain.Button1Click(Sender: TObject);
begin
MArtikel.pasteFromClipboard;
end;

procedure TFMain.Button2Click(Sender: TObject);
begin
ADODataSet1.Close;
  ADODataSet1.CommandText := 'SELECT * FROM tbl_Artikler';
  ADODataSet1.Open;

  ListBox1.Items.clear;
    ListBox2.Items.clear;
    ListBox3.Items.clear;
      ListBox4.Items.clear;
  while not adodataset1.Eof do begin

ListBox1.Items.Add(adodataset1.FieldByName('forfatter').AsString);
ListBox2.Items.Add(adodataset1.FieldByName('overskrift').AsString);
ListBox3.Items.Add(adodataset1.FieldByName('artikel').AsString);
  ListBox4.Items.Add(adodataset1.FieldByName('resume').AsString);



    adodataset1.Next;
end;  end;



  procedure TFMain.ListBox5Click(Sender: TObject);
var
  AltOK: Boolean;
begin
  AltOK:=ADOTable1.Locate('overskrift',ListBox5.Items[Listbox5.ItemIndex],[loCaseInsensitive]);
end;
procedure TFMain.Button3Click(Sender: TObject);
var
  x:Integer;
begin
  for x:=0 to adotable1.Recordset.RecordCount -1 do begin
    listbox5.Items.Add(ADOTable1.FieldByName('overskrift').AsString);
    ADOTable1.Next;
  end;
  ADOTable1.First;
end;

procedure TFMain.Button4Click(Sender: TObject);

VAR

  Lines : TStringList;

begin

begin
  Lines := TStringList.Create;


  begin
      Lines.Text :=DbMemo1.Lines.Text;

  end;

  Savedialog1.execute;  //Hvis brugeren klikker gem

lines.Savetofile(SaveDialog1.Filename);


  Lines.Free;
end;
end;
procedure PrintTStrings(Lst : TStrings) ;
var
  I,
  Line : Integer;
begin
  I := 0;
  Line := 0 ;
  Printer.BeginDoc ;
  for I := 0 to Lst.Count - 1 do begin
    Printer.Canvas.TextOut(0, Line, Lst[I]);

    {Font.Height is calculated as -Font.Size * 72 / Font.PixelsPerInch which returns
    a negative number. So Abs() is applied to the Height to make it a non-negative
    value}
    Line := Line + Abs(Printer.Canvas.Font.Height);
    if (Line >= Printer.PageHeight) then
      Printer.NewPage;
  end;
  Printer.EndDoc;
end;


procedure TFmain.printmemo1Click(Sender: TObject);
begin

  PrintTStrings(dbmemo1.lines);
end;
procedure TFMain.Button6Click(Sender: TObject);
begin
MArtikel.cuttoClipboard;
end;

end.

hrc, forsvandt du helt?

Jeg lukker. Problemet er løst.