Delphi read and write excel

Source: Internet
Author: User

Unit importfrm;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, jvexcontrols, jvcomponent, jvwizard, stdctrls, buttons, extctrls,
ActiveX, grids, jvexgrids, jvstringgrid, comobj, jvprogressbar,
Jvcomponentbase, jvthread, easylistview;

Type
Tfrmimport = Class (tform)
Jvwizard: tjvwizard;
Pgselectfile: tjvwizardinteriorpage;
Edtfilename: tlabelededit;
Btnbrowse: tbitbtn;
Dlgopen: topendialog;
Pgpreview: tjvwizardinteriorpage;
Label1: tlabel;
Cmbsheets: tcombobox;
ChkHeader: TCheckBox;
JSgView: TJvStringGrid;
PgSelectTelCol: TJvWizardInteriorPage;
Label2: TLabel;
CmbSimpleTel: TComboBox;
PgProgress: TJvWizardInteriorPage;
BtnCancel: TBitBtn;
PbProgress: TJvGradientProgressBar;
LblPerCount: TLabel;
LblTotal: TLabel;
LblCurr: TLabel;
LblErr: TLabel;
LblRep: TLabel;
ImportThread: TJvThread;
Procedure BtnBrowseClick (Sender: TObject );
Procedure PgSelectFileNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Procedure CmbSheetsChange (Sender: TObject );
Procedure FormClose (Sender: TObject; var Action: TCloseAction );
Procedure PgPreviewNextButtonClick (Sender: TObject; var Stop: Boolean );
Procedure PgSelectTelColNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Procedure ImportThreadExecute (Sender: TObject; Params: Pointer );
Procedure ImportThreadFinish (Sender: TObject );
Procedure BtnCancelClick (Sender: TObject );
Private
{Private declarations}
Public
{Public declarations}
FParams: Pointer;
Excel, books: olevariant;
Ftotal, fcurr, fper, ferr, FREP: integer;
Procedure updatedisplay;
Class procedure execute (Params: pointer );
End;

VaR
Frmimport: tfrmimport;

Implementation

Uses sendfrm;

{$ R *. DFM}

{Tfrmimport}

Class procedure tfrmimport. Execute (Params: pointer );
Begin
With tfrmimport. Create (Application) Do
Try
Fparams: = Params;
Showmodal;
Finally
Free;
End;
End;

Procedure tfrmimport. btnbrowseclick (Sender: tobject );
Begin
If not dlgopen. Execute then
Exit;

Edtfilename. Text: = dlgopen. filename;
End;

Procedure tfrmimport. pgselectfilenextbuttonclick (Sender: tobject;
VaR stop: Boolean );
VaR
I: integer;
Begin
Stop: = edtfilename. Text = '';
If stop then exit;

Try
If varisempty (Excel) then
Excel: = createoleobject ('excel. application ');
If varisempty (books) then
Books: = createoleobject ('excel. Sheet ');
Except
MessageBox (handle, 'check whether Excel is installed ', 'error', mb_iconerror + mb_ OK );
Exit;
End;

Cmbsheets. Clear;

Books: = excel. workbooks. Open (edtfilename. Text );
For I: = 1 to books. Sheets. Count do
Cmbsheets. Items. Add (books. Sheets [I]. Name );

Cmbsheets. itemindex: = 0;

Cmbsheetschange (NiL );
End;

Procedure tfrmimport. cmbsheetschange (Sender: tobject );
VaR
Row, Col: integer;
Begin
Books. Sheets [cmbsheets. text]. Activate;
Jsgview. colcount: = books. activesheet. usedrange. Columns. count;
For Col: = 1 to jsgview. colcount do
Begin
If chkheader. Checked then
Jsgview. cells [col-1, 0]: = books. activesheet. cells [1, Col]
Else
JSgView. Cells [Col-1, 0]: = Format ('f % d', [Col]);
End;

For Row: = 1 to JSgView. RowCount do
For Col: = 1 to JSgView. ColCount do
Begin
If ChkHeader. Checked then
JSgView. Cells [Col-1, Row]: = Books. ActiveSheet. Cells [Row + 1, Col]
Else
JSgView. Cells [Col-1, Row]: = Books. ActiveSheet. Cells [Row, Col];
End;
End;

Procedure TFrmImport. FormClose (Sender: TObject; var Action: TCloseAction );
Begin
If not VarIsEmpty (Books) then
Books. Close;
If not VarIsEmpty (Excel) then
Excel. Quit;

Books: = Unassigned;
Excel: = Unassigned;
End;

Procedure TFrmImport. PgPreviewNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Var
Col: Integer;
Begin
For Col: = 1 to Books. ActiveSheet. UsedRange. Columns. Count do
If ChkHeader. Checked then
CmbSimpleTel. Items. Add (Books. ActiveSheet. Cells [1, Col])
Else
CmbSimpleTel. Items. Add (Format ('f % d', [Col]);

CmbSimpleTel. ItemIndex: = 0;
End;

Procedure TFrmImport. PgSelectTelColNextButtonClick (Sender: TObject;
Var Stop: Boolean );
Begin
BtnCancel. Visible: = True;

FPer: = 0;
If ChkHeader. Checked then
FTotal: = Books. ActiveSheet. UsedRange. Rows. Count-1
Else
FTotal: = Books. ActiveSheet. UsedRange. Rows. Count;

FCurr: = 0;
FErr: = 0;
FRep: = 0;

UpdateDisplay;

ImportThread. Execute (Self );
End;

Procedure TFrmImport. UpdateDisplay;
Begin
PbProgress. Position: = FPer;
LblPerCount. Caption: = Format ('% d %', [FPer]);
LblTotal. Caption: = Format ('total import: % d', [FTotal]);
LblCurr. Caption: = Format ('current import: % d', [FCurr]);
LblErr. Caption: = Format ('error data: % d', [FErr]);
LblRep. Caption: = Format ('duplicate data: % d', [FRep]);
End;

Procedure TFrmImport. ImportThreadExecute (Sender: TObject; Params: Pointer );
Var
E, B: OleVariant;
Col, Row: Integer;
F: TFrmSend;
S: string;
Item: TEasyItem;
Begin
CoInitialize (nil );

E: = CreateOleObject ('excel. application ');
B: = CreateOleObject ('excel. Sheet ');

B: = E. WorkBooks. Open (TFrmImport (Params). EdtFileName. Text );
B. Sheets [TFrmImport (Params). CmbSheets. Text]. Activate;

F: = TFrmSend (TFrmImport (Params). FParams );
Col: = TFrmImport (Params). CmbSimpleTel. ItemIndex + 1;

For Row: = 1 to TFrmImport (Params). FTotal do
Begin
If TFrmImport (Params). ChkHeader. Checked then
S: = B. ActiveSheet. Cells [Row + 1, Col]
Else
S: = B. ActiveSheet. Cells [Row, Col];

If F. IsMobile (S) then
Inc (F. FMobileCount)
Else if F. IsUnicom (S) then
Inc (F. FUnicomCount)
Else if F. IsTelecom (S) then
Inc (F. FTelecomCount)
Else begin
Inc (TFrmImport (Params). FCurr );
Inc (TFrmImport (Params). FErr );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );
Continue;
End;

If F. CheckRepeat (S) then
Begin
Inc (TFrmImport (Params). FCurr );
Inc (TFrmImport (Params). FRep );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );
Continue;
End;

Item: = F. ELVCache. Items. Add;
Item. Caption: = S;
Item. ImageIndex: = 0;
F. FCacheHash. Add (S, Item );
Inc (TFrmImport (Params). FCurr );
TFrmImport (Params). FPer: = Trunc (TFrmImport (Params). FCurr/TFrmImport (Params). FTotal) * 100 );
ImportThread. Synchronize (TFrmImport (Params). UpdateDisplay );

If ImportThread. Terminated then
Break;
End;

If not VarIsEmpty (B) then
B. Close;
If not VarIsEmpty (E) then
E. Quit;

B: = Unassigned;
E: = Unassigned;
CoUninitialize;
End;

Procedure TFrmImport. ImportThreadFinish (Sender: TObject );
Begin
BtnCancel. Visible: = False;
PgProgress. EnableButton (bkFinish, True );
PgProgress. Title. Text: = 'import finished ';
PgProgress. Subtitle. Text: = 'data import complete, click <finish> close wizard ';
End;

Procedure TFrmImport. BtnCancelClick (Sender: TObject );
Begin
If not ImportThread. Terminated then
ImportThread. Terminate
Else
Application. ProcessMessages;
End;

Initialization
CoInitialize (nil );

Finalization
CoUninitialize;

End.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.