unit Mainprog;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DBCtrls, Grids, DBGrids, ExtCtrls,
Db, DBTables, Menus, StdCtrls, Mask,
Buttons;
type
TMainDlg =
class(TForm)
MainMenu1: TMainMenu;
Programm1: TMenuItem;
About1: TMenuItem;
Beenden1: TMenuItem;
Tabelle1: TMenuItem;
oeffnen: TMenuItem;
schliessen1: TMenuItem;
N1: TMenuItem;
anlegen1: TMenuItem;
aTable: TTable;
DataSource1: TDataSource;
Panel1: TPanel;
Panel3: TPanel;
Panel4: TPanel;
Panel2: TPanel;
DBGrid1: TDBGrid;
Label2: TLabel;
DBEdit2: TDBEdit;
DBNavigator1: TDBNavigator;
Label3: TLabel;
DBEdit3: TDBEdit;
Label4: TLabel;
OpenBtn: TSpeedButton;
CloseBtn: TSpeedButton;
BitBtn1: TBitBtn;
procedure Beenden1Click(Sender: TObject);
procedure anlegen1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
procedure oeffnenClick(Sender: TObject);
procedure CloseBtnClick(Sender: TObject);
procedure schliessen1Click(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
private
{ Private-Deklarationen }
aDatenDir:
String;
public
{ Public-Deklarationen }
end;
var
MainDlg: TMainDlg;
implementation
{$R *.DFM}
procedure TMainDlg.Beenden1Click(Sender: TObject);
begin
close;
end;
procedure TMainDlg.anlegen1Click(Sender: TObject);
var
tmpTable: TTable;
TextToShow:
String;
begin
tmpTable:= TTable.Create(self);
try
with tmpTable
do begin
DatabaseName:= aDatenDir + '
Daten';
Tablename:= '
TestTable.DB'
end;
tmpTable.Close;
if tmpTable.Exists
then begin
TextToShow:= Format('
Die Tabelle %s ist bereits angelegt' + #13#10
+ '
Soll sie überschrieben werden?',[tmpTable.Tablename]);
if MessageDlg(TextToShow,mtConfirmation,[mbOk,mbCancel],0)= mrCancel
then
Exit;
end;
with tmpTable
do begin
with FieldDefs
do begin
Clear;
Add('
ID',ftAutoInc,0,true);
Add('
Codec',ftString,10,true);
Add('
Bemerkung',ftString,30,false)
end;
with IndexDefs
do begin
Clear;
Add('
','
ID',[ixPrimary, ixUnique])
end;
CreateTable;
end;
ShowMessage('
die Tabelle wurde erfolgreich angelegt');
finally
tmpTable.Close;
tmpTable.Free;
end;
end;
procedure TMainDlg.FormCreate(Sender: TObject);
begin
aDatenDir:= ExtractFilePath(ParamStr(0));
Label4.Caption:= aDatenDir;
end;
procedure TMainDlg.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
aTable.Close
end;
procedure TMainDlg.FormShow(Sender: TObject);
begin
DBEdit2.DataSource:= DataSource1;
DBEdit2.DataField:= '
Codec';
DBEdit3.DataSource:= DataSource1;
DBEdit3.DataField:= '
Bemerkung'
end;
procedure TMainDlg.OpenBtnClick(Sender: TObject);
begin
if not aTable.Active
then
aTable.Open
end;
procedure TMainDlg.oeffnenClick(Sender: TObject);
begin
if not aTable.Active
then
aTable.Open
end;
procedure TMainDlg.CloseBtnClick(Sender: TObject);
begin
aTable.Close
end;
procedure TMainDlg.schliessen1Click(Sender: TObject);
begin
aTable.Close
end;
procedure TMainDlg.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
aValue:
string;
begin
if (gdSelected
in State)
or (gdFocused
in State)
then exit;
if Column.
Index = 1
then begin {nummer der spalte im dbgrid}
aValue:= Column.Field.asString;
{suchbegriff auslesen}
if aValue = '
DivX'
then begin
DBGrid1.Canvas.Font.Color := clYellow;
DBGrid1.Canvas.Brush.Color := clRed
end else if aValue = '
SVCD'
then begin
DBGrid1.Canvas.Font.Color := clYellow;
DBGrid1.Canvas.Brush.Color := clNavy
end else if aValue = '
VCD'
then begin
DBGrid1.Canvas.Font.Color := clWhite;
DBGrid1.Canvas.Brush.Color := clPurple
end else begin
DBGrid1.Canvas.Font.Color := clBlack;
DBGrid1.Canvas.Brush.Color := clwhite
end;
end;
DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
end.