www.pudn.com > Excel.zip > MainD.pas

unit MainD; 
 
interface 
 
uses 
  SysUtils, Classes, DB, ADODB, DBTables; 
 
type 
  TMainDm = class(TDataModule) 
    ExcelSrc: TDataSource; 
    DemoDb: TDatabase; 
    ItemsTable: TTable; 
    ExcelDb: TDatabase; 
    ExcelTable: TTable; 
    ExcelQry: TQuery; 
    procedure ExcelTableAfterOpen(DataSet: TDataSet); 
  private 
    function IsThisTheRightRow(FieldValues: Variant): Boolean; 
    procedure SaveCurrentRec(var FieldNames: String; 
      var FieldValues: Variant); 
    { Private declarations } 
  public 
    { Public declarations } 
    procedure CreateExcelFile; 
    procedure LoadData; 
    procedure OpenExcelFile; 
    procedure RefreshExcelData; 
  end; 
 
var 
  MainDm: TMainDm; 
 
implementation 
 
uses Variants, MainF, Dialogs; 
 
{$R *.dfm} 
 
const 
  ConnStr1         = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='; 
  ConnStr2         = ';Extended Properties=excel 8.0;"";'; 
  XlsName          = 'Items'; 
  XlsDir           = 'w:\di\excel\'; 
  XlsPath          = XlsDir + XlsName + '.xls'; 
  XlsTemplatePath  = XlsDir + XlsName + 'Template.xls'; 
  XlsWorksheet     = XlsName + '$'; 
 
procedure TMainDm.CreateExcelFile; 
var 
  TempFs:           TFileStream; 
  ExcelFs:          TFileStream; 
begin 
  ExcelDb.Close; 
  TempFs := TFileStream.Create(XlsTemplatePath, fmOpenRead); 
  try 
    ExcelFs := TFileStream.Create(XlsPath, fmCreate); 
    try 
      ExcelFs.CopyFrom(TempFs, 0); 
    finally 
      ExcelFs.Free; 
    end; //try 
  finally 
    TempFs.Free; 
  end; //try 
end; 
 
procedure TMainDm.OpenExcelFile; 
begin 
  ExcelTable.Open; 
end; 
 
procedure TMainDm.LoadData; 
var 
  I:          Integer; 
begin 
  MainForm.StatusBar.SimpleText := 'Loading...'; 
  ExcelTable.DisableControls; 
  try 
    ItemsTable.Open; 
    while not ItemsTable.EOF do 
    begin 
      ExcelTable.Insert; 
      for I := 0 to ItemsTable.Fields.Count - 1 do 
        ExcelTable.Fields[I].Assign(ItemsTable.Fields[I]); 
      ExcelTable.Post; 
      ItemsTable.Next; 
    end; //while 
  finally 
    ExcelTable.EnableControls; 
    MainForm.StatusBar.SimpleText := ''; 
  end; //try 
end; 
 
procedure TMainDm.SaveCurrentRec(var FieldNames: String; 
                                 var FieldValues: Variant); 
var 
  I:              Integer; 
begin 
  FieldNames := ''; 
  for I := 0 to ExcelTable.FieldDefs.Count - 1 do 
  begin 
    FieldNames := FieldNames + ExcelTable.FieldDefs[I].Name; 
    if I < ExcelTable.FieldDefs.Count - 1 then 
      FieldNames := FieldNames + ';'; 
  end; //for 
  //FieldValues := VarArrayCreate([0, ExcelTable.Fields.Count - 1], varVariant); 
  for I := 0 to ExcelTable.Fields.Count - 1 do 
    FieldValues[I] := ExcelTable.Fields[I].Value; 
end; 
 
function TMainDm.IsThisTheRightRow(FieldValues: Variant): Boolean; 
var 
  I:           Integer; 
begin 
  Result := True; 
  for I := 0 to ExcelTable.Fields.Count -1 do 
    if ExcelTable.Fields[I].Value <> FieldValues[I] then 
    begin 
      Result := False; 
      Break; 
    end; //if 
end; 
 
procedure TMainDm.RefreshExcelData; 
var 
  FieldNames:          String; 
  FieldValues:         Variant; 
  S:                   String; 
  I:                   Integer; 
begin 
  FieldValues := VarArrayCreate([0, ExcelTable.Fields.Count - 1], varVariant); 
  SaveCurrentRec(FieldNames, FieldValues); 
  ExcelTable.Close; 
  ExcelTable.Open; 
  ExcelTable.Locate(FieldNames, FieldValues, []); 
  {For some strange reason Locate leaves the cursor on the record after the 
   record it finds sometimes. So, compare the values in the current record 
   to the values in the array and if they do not match move back one record.} 
  if not IsThisTheRightRow(FieldValues) then 
    ExcelTable.Prior; 
  {If you are still not on the right row show an error message.} 
  if not IsThisTheRightRow(FieldValues) then 
    raise Exception.Create('Locate failed to find the right row.'); 
  //for I := 0 to 4 do S := S + VarToStr(FieldValues[I]) + ' | '; 
  //ShowMessage(S); 
end; 
 
procedure TMainDm.ExcelTableAfterOpen(DataSet: TDataSet); 
var 
  I:           Integer; 
begin 
  for I := 0 to ExcelTable.Fields.Count - 1 do 
    ExcelTable.Fields[I].DisplayWidth := 15; 
end; 
 
end.