Delphi-PRAXiS - Einzelnen Beitrag anzeigen - Delphi TWideStriblist kann nicht zu TStringlist zugewiesen werden

**Smiley**

Nachdem ich versucht habe alles zu verstehen, wie dieses Interface arbeitet und wie es eingebunden werden muss, habe ich folgendes

gemacht.

1. Den Typ ISharedStringList in die DLL eingebaut bei der Typen deklaration.

zusammenfalten · markieren

Delphi-Quellcode:

			Unit uCellDB;

Interface

Uses

  FastMM4,

  SysUtils,

  Classes,

  ComObj,

  ADODB,

  DB,

  Variants,

  Windows,

  StdCtrls,

  Dialogs;

// ********************** ISharedStringlist Interface ***************************

type

  ISharedStringList = interface

  ['{3F5E3362-121A-4EC4-B399-9F8CD321FC34}']

    procedure Clear; stdcall;

    function GetCount : Integer; stdcall;

    function Add(const aValue : String) : Integer; stdcall;

    procedure Delete(aIndex : Integer); stdcall;

    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;

    function IndexOf(const aValue : string) : Integer; stdcall;

    procedure Insert(aIndex : Integer; const aValue : string); stdcall;

    function  GetItem(aIndex : Integer) : String; stdcall;

    procedure SetItem(aIndex : Integer; const aValue : String); stdcall;

    property Item[aIndex : Integer] : String

      read  GetItem

      write SetItem; default;

  end;

// ********************** TCEll Objekt *****************************************

Type

  TDBCell = Record

    Name: String; // name der Zelle, wird auromatisch aus col und row generiert (A5 bei Zelle(1,5))

    Row: Integer; // Zeile der Zelle

    Col: Integer; // Spalte der Zelel

    FontName: String; // Schriftart

    FontSize: Byte; // Schriftgröße

    FontColor: Word; // Schriftfarbe

    FontStyle: Byte; //normal, Fett, italic, Underline, Strikeout (0,1,2,4,8)

    RecHight: Byte; // Höhe des Zellenrechtecks

    RecWidth: Byte; // Breite des Zellenrechtecks

    RecColor: Word; // Hintergrundfarbe des Zellenrechtecks

    RecLine: Byte; // Umrandungsstriche der Zelle 0=keine, 1=unten,2=links,4=oben,8=rechts,15=alle

    // Kombinationen einfach addieren z.B. Links und rechts ergibt 2+8=10)

    Formula: String; // Formel

    FormulaActive: Boolean; // Wenn True dann ist eine Formel in der Zelle

    Pre: String; //Vorangestellter String vor Data

    Post: String; //Stringanhängsel nach Data

    Format: String; //Datenformat z.B. ###.##

    Datatype: Byte; // Datentyp des Wertes (0=String,1=Integer;2=Float,3=Date)

    Data: String; // Datenwert, abhängig von DataType wird über den Datentyp entschieden

  End;

  //******************************************************************************

Function InitDB: Boolean;

Function DestroyDB: Boolean;

Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;

Function CreateTable(DBName, Tabelle: String): String;

Function OpenDB(DBName, TableName: String): String;

Function OpenTable(TableName: String): String;

Function ReadCell(Var DBCell: TDBCell): String;

Function ReadNextData(var Data: String; var Datatype: Integer): Boolean;

Function ReadNextInfo(var DBCell: TDBCell): Boolean;

Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;

Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;

Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;

Function SelectRowColRange(Tabelle: String; RowVon, RowBis, ColVon, ColBis: Integer): Boolean;

Function SelectNext(DBCell: TDBCell): Boolean;

Function FieldCount: Integer;

Procedure DBListTables(const Liste: ISharedStringList); stdcall; //<------------------------------

Procedure DBCompress(DBName: String);

Procedure DeleteTable(Tabelle:String);

Function SelectDB(DBName: String): String;

Function SelectInfo(Tabelle: String; Row, Col: Integer): Boolean;

Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;

Procedure ReadCellInfo(Var DBCell: TDBCell);

Procedure ReadData(Var DBCell: TDBCell);

Procedure WriteCellInfo(Var DBCell: TDBCell);

Procedure WriteData(Var DBCell: TDBCell);

.

.

.

2. Die Procedure in der DLL angepasst

zusammenfalten · markieren

Delphi-Quellcode:

			//******************************************************************************

//***************** Vorhandene Tabellen in der DB anzeigen *********************

//******************************************************************************

Procedure DBListTables(const Liste: ISharedStringlist); stdcall;

Var

  i                : Integer;

  xListe:TStringList;

Begin

 xListe := TStringList(Liste);

 xListe.Clear;

 Con1.GetTableNames(xListe, False);

  i := 0;

  Repeat

    Begin

      If (Pos('Cellinfo', xListe[i])) > 0 Then

        xListe.Delete(i);

      Inc(i);

    End;

  Until xListe.Count = i;

  i := 0;

  Repeat

    Begin

      xListe[i] := Copy(xListe[i], 1, Length(xListe[i]) - 4);

      Inc(i);

    End;

  Until xListe.Count = i;

  for i:= 0 to xListe.Count - 1 do

    Liste.Add(xListe.Strings[i]);

  xListe.Free;

End;

Das hat soweit funktioniert und lies sich compilieren

3. Dann habe ich die erzeugte DLL-Datei in mein TestProgramm Verzeichnis kopiert.

4. Einbinden der Typ ISharedStringList und TSharedStringListWrapper in das Testprogramm.
5. Einbinden der Wrapper Funktionen in das Testprogramm.

zusammenfalten · markieren

Delphi-Quellcode:

			Unit uMainReadTest;

Interface

Uses

  FastMM4, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, uCellDB;

Type

  TForm1 = Class(TForm)

    btnStart: TButton;

    lblText: TLabel;

    lblDauer: TLabel;

    lblText1: TLabel;

    lblText1D: TLabel;

    lblFehlerText: TLabel;

    lblFehlerDaten: TLabel;

    btnDropTable: TButton;

    btnListTables: TButton;

    lstTables: TListBox;

    btnReadRowRange: TButton;

    btnReadColRange: TButton;

    btnListFields: TButton;

    btnCreateTable: TButton;

    Procedure btnCreateTableClick(Sender: TObject);

    Procedure btnDropTableClick(Sender: TObject);

    Procedure btnListFieldsClick(Sender: TObject);

    Procedure btnReadColRangeClick(Sender: TObject);

    Procedure btnReadRowRangeClick(Sender: TObject);

    Procedure btnListTablesClick(Sender: TObject);

    Procedure btnStartClick(Sender: TObject);

    Procedure FormShow(Sender: TObject);

    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);

  Private

    { Private-Deklarationen }

  Public

    { Public-Deklarationen }

  End;

type

  ISharedStringList = interface

  ['{3F5E3362-121A-4EC4-B399-9F8CD321FC34}']

    procedure Clear; stdcall;

    function GetCount : Integer; stdcall;

    function Add(const aValue : String) : Integer; stdcall;

    procedure Delete(aIndex : Integer); stdcall;

    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;

    function IndexOf(const aValue : string) : Integer; stdcall;

    procedure Insert(aIndex : Integer; const aValue : string); stdcall;

    function  GetItem(aIndex : Integer) : String; stdcall;

    procedure SetItem(aIndex : Integer; const aValue : String); stdcall;

    property Item[aIndex : Integer] : String

      read  GetItem

      write SetItem; default;

  end;

type

  TSharedStringListWrapper = class(TInterfacedObject, ISharedStringList)

  private

    fInnerList: TStrings;

  protected

    function  GetCount: Integer; stdcall;

    procedure Clear; stdcall;

    function Add(const aValue: String): Integer; stdcall;

    procedure Delete(aIndex : Integer); stdcall;

    procedure Exchange(aIndex1, aIndex2 : Integer); stdcall;

    function IndexOf(const aValue : String) : Integer; stdcall;

    procedure Insert(aIndex : Integer; const aValue : String); stdcall;

    function  GetItem(aIndex: Integer): String; stdcall;

    procedure SetItem(aIndex: Integer; const aValue: String); stdcall;

  public

    property InnerList : TStrings read fInnerList;

    constructor Create(aInnerList : TStrings);

    class function Wrap(aInnerList : TStrings) : ISharedStringList;

  end; 

Var

  Form1                       : TForm1;

  DBError                     : String;

  ProgPath                    : String;

  DBCell                      : TDBCell;

  Cache                       : Array[1..50, 1..10] Of TDBCell;

Function InitDB: Boolean;

Function DestroyDB: Boolean;

Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;

Function CreateTable(DBName, Tabelle: String): String;

Function OpenDB(DBName, TableName: String): String;

Function OpenTable(TableName: String): String;

Function ReadCell(Var DBCell: TDBCell): String;

Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;

Function SelectDB(DBName: String): String;

Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;

Procedure ReadCellInfo(Var DBCell: TDBCell);

Procedure WriteCellInfo(Var DBCell: TDBCell);

Procedure DBCompress(DBName: String);

Procedure DeleteTable(Tabelle: String);

Procedure DBListTables(Const Liste: ISharedStringList); stdcall;

//Procedure DBListTables(var Liste:TObject);

Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;

Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;

Function ReadNextData(Var Data: String; Var Datatype: Integer): Boolean;

Function ReadNextInfo(Var DBCell: TDBCell): Boolean;

Function FieldCount: Integer;

Implementation

{$R *.dfm}

Const

  DllPath                     = 'CellDB.dll';

Function InitDB: Boolean;

  External DllPath;

Function DestroyDB: Boolean;

  External DllPath;

Function CreateDB(DBName: String; DelIfExists: Boolean = False): String;

  External DllPath;

Function CreateTable(DBName, Tabelle: String): String;

  External DllPath;

Function OpenDB(DBName, TableName: String): String;

  External DllPath;

Function OpenTable(TableName: String): String;

  External DllPath;

Function ReadCell(Var DBCell: TDBCell): String;

  External DllPath;

Function WriteCell(Var DBCell: TDBCell; WriteInfo: Boolean): String;

  External DllPath;

Function SelectDB(DBName: String): String;

  External DllPath;

Function SelectData(Tabelle: String; Row, Col: Integer): Boolean;

  External DllPath;

Procedure ReadCellInfo(Var DBCell: TDBCell);

  External DllPath;

Procedure WriteCellInfo(Var DBCell: TDBCell);

  External DllPath;

Procedure DBCompress(DBName: String);

  External DllPath;

Function SelectRowRange(Tabelle: String; RowVon, RowBis: Integer): Boolean;

  External DllPath;

Function SelectColRange(Tabelle: String; ColVon, ColBis: Integer): Boolean;

  External DllPath;

Procedure DBListTables(Const Liste: ISharedStringlist); stdcall;

//Procedure DBListTables(var Liste:TObject);

External DllPath;

Procedure DeleteTable(Tabelle: String);

  External DllPath;

Function ReadNextData(Var Data: String; Var Datatype: Integer): Boolean;

  External DllPath;

Function ReadNextInfo(Var DBCell: TDBCell): Boolean;

  External DllPath;

Function FieldCount: Integer;

  External DllPath;

{ TSharedStringListWrapper }

function TSharedStringListWrapper.Add(const aValue : String) : Integer;

begin

  result := InnerList.Add(aValue);

end;

procedure TSharedStringListWrapper.Clear;

begin

  InnerList.Clear();

end;

constructor TSharedStringListWrapper.Create(aInnerList : TStrings);

begin

  inherited Create();

  fInnerList := aInnerList;

end;

procedure TSharedStringListWrapper.Delete(aIndex : Integer);

begin

  InnerList.Delete(aIndex);

end;

procedure TSharedStringListWrapper.Exchange(aIndex1, aIndex2 : Integer);

begin

  InnerList.Exchange(aIndex1, aIndex2);

end;

function TSharedStringListWrapper.GetCount : Integer;

begin

  result := InnerList.Count;

end;

function TSharedStringListWrapper.GetItem(aIndex : Integer) : String;

begin

  result := InnerList[aIndex];

end;

function TSharedStringListWrapper.IndexOf(const aValue : String) : Integer;

begin

  result := InnerList.IndexOf(aValue);

end;

procedure TSharedStringListWrapper.Insert(aIndex : Integer;

  const aValue : String);

begin

  InnerList.Insert(aIndex, aValue);

end;

procedure TSharedStringListWrapper.SetItem(aIndex : Integer;

  const aValue : String);

begin

  InnerList[aIndex] := aValue;

end;

class function TSharedStringListWrapper.Wrap(aInnerList : TStrings) : ISharedStringList;

begin

  result := Create(aInnerList);

end;

6. Den Aufruf im Testprogramm angepasst.

zusammenfalten · markieren

Delphi-Quellcode:

			//******************************************************************************

//*********************** Tabellen in DB auflisten *****************************

//******************************************************************************

Procedure TForm1.btnListTablesClick(Sender: TObject);

procedure FillTableNames(const aTableNames : TStrings);

begin

  DBListTables(TSharedStringListWrapper.Wrap(aTableNames));

end;

Begin

  FillTableNames(lstTables.Items); // Listbox füllen

End;

Sobald ich nun den Button btnListTables ausführe, kommt die angehängte Fehlermeldung, sobald die DLL angesprochen wird.

Was mache ich hier falsch ?

Einzelnen Beitrag anzeigen

Re: TWideStriblist kann nicht zu TStringlist zugewiesen werd