unit Datenbankkomponente;
interface
uses Windows, SysUtils, Forms, Messages, Classes, Controls, Graphics, ExtCtrls, StdCtrls,
ActiveX, DateiArbeit, ExcelXP, Variants, Dialogs, LabZahlEditEinheit, LabZahlEdit;
const ExcelDatenbankName = '
Datenbank.xls';
type TDatenbankoberflaeche =
class(TWinControl)
private
FExcelApplication: TExcelApplication;
FExcelWorkbook: TExcelWorkbook;
FExcelWorksheet: TExcelWorksheet;
FDatenbankDatei: TDateiArbeit;
FsLPfade, FsLAllNamen, FsLTempdaten: TStringList;
//FgewSensordaten: TSensordaten;
FsDatenbankPfad:
string;
FIZeichnungsdarstellung: TImage;
FLEHuellenlaenge, FLEHuellendurchmesser, FLEGap,
FLElinkeSpleissPos, FLErechteSpleissPos: TLabZahlEditEinheit;
FCBListe: TCombobox;
FBtLoeschen, FBtSpeichern: TButton;
FEdNeuerSensorName: TLabeledEdit;
procedure SetItemsComboBox(
var Box: TComboBox; List: TStringList);
// Erstellt die für die ComboBox nötigen Einträge
function CreateImage: TImage;
function CreateLabZahlEditEinheit(PosX, PosY, Textgroesse: integer; Einheit:
string): TLabZahlEditEinheit;
function CreateComboBox(PosX, PosY, Width: integer): TComboBox;
function CreateButton(PosX, PosY, Height, Width: integer; Text:
string; Enabled: boolean): TButton;
function CreateLabeledEdit(PosX, PosY: integer): TLabeledEdit;
procedure BtLoeschenClick(Sender: TObject);
procedure BtSpeichernClick(Sender: TObject);
procedure LabZahlEditEinheitOnChange;
function GetItemIndex: integer;
procedure GetComboBoxChange(Sender: TObject);
function GetArbeitsPfad:
string;
function GetHuellenlaenge: double;
function GetHuellendurchmesser: double;
function GetGap: double;
function GetliSpleisspos: double;
function GetreSpleisspos: double;
function ProgIDExists(
const ProgID: WideString): Boolean;
function Verfuegbarkeit: boolean;
function ExcelVerfuegbarkeit: boolean;
function DateiVerfuegbarkeit: boolean;
procedure ExcelDatenbank_anlegen;
procedure GetAllNamen;
procedure GetAlldaten(
var List: TStringList;
Index: integer);
procedure LabZahlEditEinheit_beschreiben(List: TStringList);
protected
procedure CreateWnd;
override;
published
public
constructor create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure Initialisieren;
property Arbeitspfad:
string read GetArbeitsPfad;
property Dateipfade: TStringList
read FsLPfade;
property Huellenlaenge: double
read GetHuellenlaenge;
property Huellendurchmesser: double
read GetHuellendurchmesser;
property Gap: double
read GetGap;
property liSpleisspos: double
read GetliSpleisspos;
property reSpleisspos: double
read GetreSpleisspos;
end;
{$R Zeichnung.RES}
implementation
{////////////////////////////////////////////////////////////////////////////////////}
{/ create und destroys /}
{////////////////////////////////////////////////////////////////////////////////////}
constructor TDatenbankoberflaeche.Create(AOwner: TComponent);
begin
inherited create(AOwner);
Controlstyle := Controlstyle - [csAcceptsControls];
Visible := true;
Width := 600;
Height := 400;
FsLPfade := TStringList.Create;
FsLAllNamen := TStringList.Create;
FsLTempdaten := TStringList.Create;
FDatenbankDatei := TDateiArbeit.create(
nil, ExcelDatenbankName);
FsLPfade := FDatenbankDatei.Dateipfad;
end;
Destructor TDatenbankoberflaeche.Destroy;
begin
FExcelWorkbook.Close(true);
// Speichert die Änderungen in Excel
FExcelWorksheet.Free;
FExcelWorkbook.Free;
FExcelApplication.Free;
FsLTempdaten.Free;
FsLPfade.Free;
FsLAllNamen.Free;
FIZeichnungsdarstellung.Free;
FDatenbankDatei.Free;
FLEHuellenlaenge.Free;
FLEHuellendurchmesser.Free;
FLEGap.Free;
FLElinkeSpleissPos.Free;
FLErechteSpleissPos.Free;
FIZeichnungsdarstellung.Free;
FEdNeuerName.Free;
FCBListe.Free;
FBtLoeschen.Free;
FBtSpeichern.Free;
inherited Destroy;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ create-Funktionen der Komponenten /}
{////////////////////////////////////////////////////////////////////////////////////}
function TDatenbankoberflaeche.CreateImage: TImage;
begin
result := TImage.Create(
nil);
result.Parent := Self;
result.Left := 0;
result.Top := 10;
result.Width := 600;
result.Height := 400;
result.Picture.Bitmap.LoadFromResourceName(HInstance, '
techZeichnung');
result.Visible := true;
result.Transparent := true;
result.BringToFront;
result.Refresh;
end;
function TDatenBankoberflaeche.CreateLabZahlEditEinheit(PosX: Integer; PosY: Integer;
Textgroesse: Integer; Einheit:
string): TLabZahlEditEinheit;
begin
result := TLabZahlEditEinheit.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Einheit := Einheit;
result.Zahltyp := ZtGleitkommazahl;
result.Font.Size := Textgroesse;
result.Font.Style := [fsBold];
end;
function TDatenBankoberflaeche.CreateComboBox(PosX, PosY, Width: integer): TComboBox;
begin
result := TComboBox.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Height := 20;
result.Width := Width;
result.Clear;
result.OnChange := GetComboBoxChange;
end;
function TDatenbankoberflaeche.CreateButton(PosX: Integer; PosY: Integer; Height: Integer; Width: Integer; Text:
string; Enabled: boolean): TButton;
begin
result := TButton.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Height := Height;
result.Width := Width;
result.Caption := Text;
result.Enabled := Enabled;
end;
function TDatenbankoberflaeche.CreateLabeledEdit(PosX: Integer; PosY: Integer): TLabeledEdit;
begin
result := TLabeledEdit.Create(
nil);
result.Parent := Self;
result.Left := PosX;
result.Top := PosY;
result.Width := 150;
result.EditLabel.Caption := '
Name für neuen Sensor eingeben';
result.Text := '
empty';
result.Enabled := false;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Getter und Setter /}
{////////////////////////////////////////////////////////////////////////////////////}
function TDatenBankoberflaeche.GetArbeitsPfad:
string;
var Index: integer;
sparentroot, sTemp:
string;
begin
result := '
';
sparentroot := ExtractFilePath(ParamStr(0));
for Index := 0
to FsLPfade.Count-1
do
begin
sTemp := FsLPfade[
Index];
delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
if sparentroot = stemp
then
begin
result := sTemp;
break;
end;
end;
if result = '
'
then
begin
sTemp := FDatenbankDatei.LastModifiedDateiPfad;
delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
result := sTemp;
end;
if result = '
'
then
begin
sTemp := FsLPfade[0];
delete(sTemp,Length(sTemp)-Length(ExcelDatenbankName)+1,Length(ExcelDatenbankName));
result := sTemp;
end;
end;
procedure TDatenbankoberflaeche.SetItemsComboBox(
var Box: TComboBox; List: TStringList);
begin
Box.Items := List;
if List.Count > 1
then Box.ItemIndex := 1
else Box.ItemIndex := 0;
end;
function TDatenbankoberflaeche.GetHuellenlaenge;
begin
result := FLEHuellenlaenge.Value;
end;
function TDatenbankoberflaeche.GetHuellendurchmesser;
begin
result := FLEHuellendurchmesser.Value;
end;
function TDatenbankoberflaeche.GetGap;
begin
result := FLEGap.Value;
end;
function TDatenbankoberflaeche.GetliSpleisspos;
begin
result := FLElinkeSpleissPos.Value;
end;
function TDatenbankoberflaeche.GetreSpleisspos;
begin
result := FLErechteSpleisspos.Value;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Gesamtverfügbarkeit /}
{////////////////////////////////////////////////////////////////////////////////////}
function TDatenbankoberflaeche.Verfuegbarkeit: boolean;
begin
if Dateiverfuegbarkeit
and Excelverfuegbarkeit
then result := true
else result := false;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Datei vorhanden /}
{////////////////////////////////////////////////////////////////////////////////////}
function TDatenbankoberflaeche.DateiVerfuegbarkeit: boolean;
begin
if (FsLPfade.Count > 0)
then result := true
else result := false;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Buttonclick-Proceduren /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.BtLoeschenClick(Sender: TObject);
var Index, i: integer;
begin
FBtSpeichern.Enabled := false;
FEdNeuerName.Enabled := false;
Index := GetItemIndex;
// Löscht den ausgewählten Sensor
if Index > 0
then
begin
FExcelWorksheet.Range['
A'+ inttostr(
Index+3),'
A'+inttostr(
Index+3)].EntireRow.Delete(xlUp);
// Angleichen der Laufenden Nummer
if (
Index < FsLAllNamen.Count - 2)
then
begin
for i :=
Index to FsLAllNamen.Count - 2
do FExcelWorksheet.Cells.Item[i+3,1] := strtoint(FExcelWorksheet.Cells.Item[i+3,1]) - 1;
end;
// Daten neu einlesen und ItemIndex auf den ersten Sensor setzen
FsLAllNamen.Clear;
// Löscht alle Sensornamen aus der Liste
GetAllNamen;
SetItemsComboBox(FCBListe, FsLAllSensorNamen);
GetAllDaten(FsLTempdaten, GetItemIndex);
LabZahlEditEinheit_beschreiben(FsLTemdaten);
end;
end;
procedure TDatenbankoberflaeche.BtSpeichernClick(Sender: TObject);
var Index: integer;
begin
Index := FCBSensorListe.Items.Count + 3;
if Index > 4
then FExcelWorksheet.Cells.Item[
Index,1] := strtoint(FExcelWorksheet.Cells.Item[
Index-1,1]) + 1
else FExcelWorksheet.Cells.Item[
Index,1] := '
1';
FExcelWorksheet.Cells.Item[
Index,2] := FEdNeuerName.Text;
FExcelWorksheet.Cells.Item[
Index,3] := FLEHuellenlaenge.Value;
FExcelWorksheet.Cells.Item[
Index,4] := FLEHuellendurchmesser.Value;
FExcelWorksheet.Cells.Item[
Index,5] := FLEGap.Value;
FExcelWorksheet.Cells.Item[
Index,6] := FLElinkeSpleissPos.Value;
FExcelWorksheet.Cells.Item[
Index,7] := FLErechteSpleissPos.Value;
FsLAllNamen.Clear;
// Löscht alle Namen aus der Liste
GetAllNamen;
SetItemsComboBox(FCBListe, FsLAllNamen);
GetAllDaten(FsLTempdaten, GetItemIndex);
LabZahlEditEinheit_beschreiben(FsLTempdaten);
FBtSpeichern.Enabled := false;
FEdNeuerName.Enabled := false;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ OnChange-Prozedure für die LabZahlEditEinheit-Komponenten /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.LabZahlEditEinheitOnChange;
var i: integer;
bgefunden: boolean;
begin
bgefunden := false;
for i := 1
to FsLAllNamen.Count-1
do
begin
GetALLSensorDaten(FsLTempSensorDaten,i);
if (FLEHuellenlaenge.Value = strtofloat(FsLTempDaten[0]))
and
(FLEHuellendurchmesser.Value = strtofloat(FsLTempDaten[1]))
and
(FLEGap.Value = strtofloat(FsLTempDaten[2]))
and
(FLElinkeSpleissPos.Value = strtofloat(FsLTempDaten[3]))
and
(FLErechteSpleissPos.Value = strtofloat(FsLTempDaten[4]))
then
begin
bgefunden := true;
break;
end;
end;
if bgefunden = true
then
begin
FCBListe.ItemIndex := i;
GetAllDaten(FsLTempdaten, GetItemIndex);
LabZahlEditEinheit_beschreiben(FsLTempdaten);
end
else
begin
if (FLEHuellenlaenge.Text <> '
empty')
and
(FLEHuellendurchmesser.Text <> '
empty')
and
(FLEGap.Text <> '
empty')
and
(FLElinkeSpleissPos.Text <> '
empty')
and
(FLErechteSpleissPos.Text <> '
empty')
then
begin
FBtSpeichern.Enabled := true;
FEdNeuerName.Enabled := true;
FEdNeuerName.Text := '
Sensor' + '
' + datetostr(now) + '
' + timetostr(now);
end;
end;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Excelfunktionen /}
{////////////////////////////////////////////////////////////////////////////////////}
function TDatenbankoberflaeche.ProgIDExists(
const ProgID:WideString):Boolean;
var
tmp : TGUID;
begin
Result := Succeeded(CLSIDFromProgID(PWideChar(ProgID), tmp));
end;
function TDatenbankoberflaeche.ExcelVerfuegbarkeit: boolean;
begin
// Es muss das Office-Packet 2003 auf dem Rechner installiert sein, damit diese
// Komponente funktioniert. Dies ist nötig, da in jeder Version des Office-Packetes
// unterschiedlich viele Parameter zum öffnen einer Datei benötigt werden.
// Wenn kein oder ein falsches Office-Packet installiert ist, wird die Komponente
// in der CreateWnd-Procedure disabled.
if ProgIDExists('
Excel.Application.11')
then result := true
else result := false;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ createWND-Funktion /}
{////////////////////////////////////////////////////////////////////////////////////}
// Erzeugt alle nötigen Komponenten und prüft die Verfügbarkeit der Datenbank und Excel
procedure TDatenbankoberflaeche.CreateWnd;
begin
inherited createwnd;
// Initalisierung aller nötigen Komponenten
FIZeichnungsdarstellung := CreateImage;
FLEGap := CreateLabZahlEditEinheit(110,0,8,'
µm');
FLEGap.OnChange := LabZahlEditEinheitOnChange;
FLElinkeSpleissPos := CreateLabZahlEditEinheit(220,188,8,'
mm');
FLElinkeSpleissPos.OnChange := LabZahlEditEinheitOnChange;
FLErechteSpleissPos := CreateLabZahlEditEinheit(200,146,8,'
mm');
FLErechteSpleissPos.OnChange := LabZahlEditEinheitOnChange;
FLEHuellenlaenge := CreateLabZahlEditEinheit(200,230,8,'
mm');
FLEHuellenlaenge.OnChange := LabZahlEditEinheitOnChange;
FLEHuellendurchmesser := CreateLabZahlEditEinheit(0,147,8,'
mm');
FLEHuellendurchmesser.OnChange := LabZahlEditEinheitOnChange;
FCBListe := CreateComboBox(350,10,150);
FBtLoeschen := CreateButton(20,300,20,60,'
Löschen',true);
FBtLoeschen.OnClick := BtLoeschenClick;
FBtLoeschen.BringToFront;
FBtSpeichern := CreateButton(120,300,20,60,'
Speichern',false);
FBtSpeichern.OnClick := BtSpeichernClick;
FBtSpeichern.BringToFront;
FEdNeuerName := CreateLabeledEdit(350,55);
// Prüft ob alle Voraussetzungen zu Verwendung der Datenbank gegeben sind und
// schaltet die Komponente ein oder aus und gibt Fehlermeldungen aus
if Verfuegbarkeit
then
begin
Enabled := true;
FsDatenbankPfad := GetArbeitspfad;
end
else
begin
if not ExcelVerfuegbarkeit
then
begin
MessageBox(Self.Handle, '
Sie haben keine oder eine falsche Version Office auf dem Rechner installiert. Bitte verwenden sie MS Office 2003, damit eine fehlerfreie Verwendung der Datenbank gewährleistet ist.',
'
MS Excel 2003 nicht gefunden', MB_OK);
Enabled := false;
end
else if not DateiVerfuegbarkeit
then
begin
ExcelDatenbank_anlegen;
Enabled := true;
end;
end;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Initialisierungsfunktion /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.Initialisieren;
var DWResult: DWORD;
iUserLCID: integer;
begin
if Enabled
then
begin
iUserLCID := GetUserDefaultLCID;
// Wenn die Datenbank extern über Excel geöffnet ist dann wird sie geschlossen.
// wenn diese Datei nicht geschlossen wird, dann kommt es zu einer Exception!!!
if FindWindow('
XLMain','
Microsoft Excel - ' + ExcelDatenbankName) <> 0
then
SendMessageTimeout(FindWindow('
XLMain','
Microsoft Excel - ' + ExcelDatenbankName), WM_CLOSE, 0, 0,
SMTO_ABORTIFHUNG
or SMTO_NORMAL, 5000, DWResult);
FExcelApplication := TExcelApplication.Create(
Nil);
FExcelWorkbook := TExcelWorkbook.create(
Nil);
FExcelWorksheet := TExcelWorksheet.create(
Nil);
// vorhandener Exceldatei laden !!! wichtig !!! Die Anzahl der emtyParam ist Office-Versions abhängig
FExcelApplication.Workbooks.Open(FsDatenbankPfad + ExcelDatenbankName, emptyParam, emptyParam, emptyParam, emptyParam
, emptyParam, emptyParam, emptyParam, emptyParam, emptyParam, emptyParam, emptyParam, emptyParam
, emptyParam, emptyParam, iUserLCID);
// Excel soll NICHT angezeigt werden
FExcelApplication.visible[iUserLCID] := true;
// verbinden des Workbooks und des Worksheets mit der in der exc geladenen Datei
FExcelWorkbook.ConnectTo(FExcelApplication.ActiveWorkbook);
FExcelWorksheet.ConnectTo(FExcelWorkbook.ActiveSheet
as ExcelWorksheet);
//Showmessage(FExcelWorksheet.Shapes.Range[1].;
GetAllSensorNamen;
SetItemsComboBox(FCBListe, FsLAllNamen);
GetAllSensorDaten(FsLTempdaten, GetItemIndex);
LabZahlEditEinheit_beschreiben(FsLTempdaten);
//Showmessage(inttostr(FExcelWorksheet.Shapes.Count));
end
else MessageBox(Self.Handle, '
Es sind Fehler beim Öffnen der Datenbank aufgetreten. Bitte beachten sie die Meldungen.', '
Datenbank kann nicht geladen werden',MB_OK);
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Datenbank auslesen /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.GetAllNamen;
var Index: integer;
sTemp:
string;
begin
FsLAllNamen.Add('
Neuer Name');
Index := 0;
sTemp := FExcelWorksheet.Cells.Item[
Index+4,2];
while sTemp <> '
'
do
begin
FsLAllNamen.Add(FExcelWorksheet.Cells.Item[
Index+4,2]);
Index :=
Index + 1;
sTemp := FExcelWorksheet.Cells.Item[
Index+4,2]
end;
end;
function TDatenbankoberflaeche.GetItemIndex: integer;
begin
result := FCBListe.ItemIndex;
end;
// Diese Funktion sollte die Daten in eine reine StringList oder Record eintragen
// und die Ausgabe in einer seperaten Funktion. Somit könnte die Funktion noch
// bei anderen Tätigkeiten eingebunden werden, wie z.B. der Überprüfung, ob es
// sich bei den Daten in der Komponente um einen neuen Namen handelt.
procedure TDatenbankoberflaeche.GetAlldaten(
var List: TStringList;
Index: integer);
var i: integer;
begin
List.Clear;
if Index <> 0
then for i := 0
to 4
do List.Add(FExcelWorksheet.Cells.Item[
Index+3,3+i])
else for i := 0
to 4
do List.Add('
empty');
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Datenbankoberfläche beschreiben /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.LabZahlEditEinheit_beschreiben(List: TStringList);
var Index: integer;
begin
Index := GetItemIndex;
if Index <> 0
then
begin
FLEHuellenlaenge.Value := strtofloat(List[0]);
FLEHuellendurchmesser.Value := strtofloat(List[1]);
FLEGap.Value := strtofloat(List[2]);
FLElinkeSpleissPos.Value := strtofloat(List[3]);
FLErechteSpleissPos.Value := strtofloat(List[4]);
end
else
begin
FLEHuellenlaenge.Text := List[0];
FLEHuellendurchmesser.Text := List[1];
FLEGap.Text := List[2];
FLElinkeSpleissPos.Text := List[3];
FLErechteSpleissPos.Text := List[4];
end;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Datenbank anlegen /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TDatenbankoberflaeche.ExcelDatenbank_anlegen;
var sparentroot:
string;
iUserLCID: integer;
begin
sparentroot := ExtractFilePath(ParamStr(0));
FsDatenbankPfad := sparentroot;
iUserLCID := GetUserDefaultLCID;
FExcelApplication := TExcelApplication.Create(
Nil);
FExcelApplication.Workbooks.Add(emptyparam, iUserLCID);
FExcelWorkbook := TExcelWorkbook.create(
Nil);
FExcelWorkbook.ConnectTo(FExcelApplication.ActiveWorkbook
as ExcelWorkbook);
FExcelWorkbook.Worksheets.Add(emptyParam, emptyParam, emptyParam, emptyParam, iUserLCID);
FExcelWorksheet := TExcelWorksheet.create(
Nil);
FExcelWorksheet.ConnectTo(FExcelWorkbook.ActiveSheet
as ExcelWorksheet);
FExcelWorksheet.Cells.Item[3,1] := '
Lfd. Nr.';
FExcelWorksheet.Cells.Item[3,2] := '
Name';
FExcelWorksheet.Cells.Item[3,3] := '
Hüllenlänge';
FExcelWorksheet.Cells.Item[3,4] := '
Hüllendurchmesser';
FExcelWorksheet.Cells.Item[3,5] := '
Gap';
FExcelWorksheet.Cells.Item[3,6] := '
li Spleißpos';
FExcelWorksheet.Cells.Item[3,7] := '
re Spleißpos';
FExcelWorkbook.Close(true, sparentroot + ExcelDatenbankName, emptyParam, iUserLCID);
// Speichert die Änderungen in Excel }
FExcelWorksheet.Free;
FExcelWorkbook.Free;
FExcelApplication.Free;
end;
procedure TDatenbankoberflaeche.GetComboBoxChange(Sender: TObject);
begin
FBtSpeichern.Enabled := false;
FEdNeuerName.Enabled := false;
GetAllDaten(FsLTempdaten, GetItemIndex);
LabZahlEditEinheit_beschreiben(FsLTempdaten);
end;
end.
Programmierung allgemein
Antwort
22. Jun 2009, 14:10
Zitat
Zitat von mkinzler:
, zeigen will plus einer kleinen Testkomponente. Das soll allerdings eher eine "Eigenkontrolle" für mich sein, da sicherlich noch einige Änderungen/ Verbesserungen mit Try-Finaly und Try-Except vorgenommen werden können.
Linear-Darstellung
