В общем есть программа всё работает. Смысл загружает таблицу Excel но загружает долго. Обычному пользователю не очень понятно когда завершилась загрузка,нужно сделать ,чтобы было написано что загрузка завершена. Потом при нажатии на кнопку фильтр выводит ответы выводится в неудобном консольном окне. И всё сполшником можно как нибудь облагородить. Вот код
Код:
unit class_fMain;
interface
uses
Windows,
Messages,
SysUtils,
Classes,
Variants,
Graphics,
Controls,
Forms,
Dialogs,
Grids,
ComObj,
StdCtrls;
type
TfMain = class(TForm)
sgExcel: TStringGrid;
btnOpenFile: TButton;
OpenDlg: TOpenDialog;
btnFind: TButton;
Label1: TLabel;
procedure btnOpenFileClick(Sender: TObject);
procedure btnFindClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
fMain: TfMain;
implementation
{$R *.dfm}
procedure Xls_Open(XLSFile:string; Grid: TStringGrid);
//Ñ÷èòûâàåò Excel â StringGrid.
const
xlCellTypeLastCell = $0000000B;
var
ExlApp, Sheet: OLEVariant;
i, j, r, c: Integer;
begin
ExlApp := CreateOleObject('Excel.Application');
try
ExlApp.Visible := false;
ExlApp.Workbooks.Open(XLSFile);
Sheet := ExlApp.Workbooks[ExtractFileName(XLSFile)].WorkSheets[1];
Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;
r := ExlApp.ActiveCell.Row;
c := ExlApp.ActiveCell.Column;
Grid.RowCount:=r;
Grid.ColCount:=c;
for j:= 1 to r do
for i:= 1 to c do
Grid.Cells[i-1,j-1]:= sheet.cells[j,i];
finally
ExlApp.Quit;
ExlApp := Unassigned;
Sheet := Unassigned;
end;
end;
procedure AutoSizeGridColumn(Grid : TStringGrid; Column : Integer);
//Àâòîðàçìåð êîëîíîê StringGrid ïîä øèðèíó òåêñòà.
var
I : Integer;
Temp : Integer;
Max : Integer;
begin
Max := 0;
for i := 0 to (Grid.RowCount - 1) do
begin
Temp := Grid.Canvas.TextWidth(Grid.Cells[Column, I]);
if Temp > Max
then Max := Temp;
end;
Grid.ColWidths[Column] := Max + Grid.GridLineWidth + 10;
end;
procedure TfMain.btnOpenFileClick(Sender: TObject);
var
X: Integer;
begin
OpenDlg.InitialDir:=ExtractFilePath(ParamStr(0));
if OpenDlg.Execute then
begin
Xls_Open(OpenDlg.Files[0], sgExcel);
for x := 0 to sgExcel.ColCount-1 do
AutoSizeGridColumn(sgExcel, x);
end;
end;
procedure TfMain.btnFindClick(Sender: TObject);
type
Rec = record
sgLine: Integer;
cData: String;
sData: String;
fCount: Integer;
end;
var
x: Integer;
cache: array of Rec;
procedure FillData(Col1, Col2: String; Addr: Integer);
var
I: Integer;
Found: Boolean;
begin
Found:=False;
for I := Low(cache) to High(Cache) do
begin
if
(Cache[i].cData = trim(lowercase(Col1))) and
(Cache[i].sData = trim(lowercase(Col2)))
then
begin
Inc(Cache[i].fCount);
Found:=True;
Break;
end;
end;
if not Found then
begin
SetLength(Cache, Length(Cache)+1);
Cache[Length(Cache)-1].cData:=Trim(Lowercase(Col1));
Cache[Length(Cache)-1].sData:=Trim(Lowercase(Col2));
Cache[Length(Cache)-1].fCount:=1;
Cache[Length(Cache)-1].sgLine:=Addr;
end;
end;
begin
//Îòôèëüòðóåì íóæíûå çíà÷åíèÿ ïî ïî 3 è 7-é êîëîíêå îäíîâðåìåííî.
for x := 1 to sgExcel.RowCount-1 do FillData(sgExcel.Cells[3,x], sgExcel.Cells[7,x], x);
//Ïîêàæåì ãäå ó íàñ íóæíûå çíà÷åíèÿ.
for x := Low(cache) to High(cache) do
if cache[x].fCount > 1
then MessageBox
(
Handle,
pChar(Format('Çíà÷åíèÿ: [%d], %s, êîëè÷åñòâî: %d',
[
cache[x].sgLine,
cache[x].cData + ' ' + cache[x].sData,
cache[x].fCount
])),
pChar(fMain.Caption),
MB_ICONINFORMATION or MB_OK
);
end;
end.