Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Отчет Ковагареня Технологическая практика.doc
Скачиваний:
0
Добавлен:
01.07.2025
Размер:
111.1 Кб
Скачать

Приложение а

unit Unit1;

interface

uses

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

Dialogs, Grids, DBGrids, acDBGrid, StdCtrls, sGroupBox, Buttons, sBitBtn,

Menus, sSkinManager, DB, ADODB, sLabel, sEdit, sComboBox, ExtCtrls, ComObj,

ExcelXP, OleServer, QuickRpt, ActiveX, sSkinProvider;

type

TForm1 = class(TForm)

sDBGrid1: TsDBGrid;

MainMenu1: TMainMenu;

V1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

sGroupBox1: TsGroupBox;

sGroupBox2: TsGroupBox;

sBitBtn1: TsBitBtn;

sBitBtn2: TsBitBtn;

sBitBtn3: TsBitBtn;

sBitBtn4: TsBitBtn;

sSkinManager1: TsSkinManager;

DataSource1: TDataSource;

ADOConnection1: TADOConnection;

ADOTable1: TADOTable;

ADOQuery1: TADOQuery;

sEdit1: TsEdit;

sLabel1: TsLabel;

sLabel2: TsLabel;

DataSource2: TDataSource;

sComboBox1: TsComboBox;

sBitBtn5: TsBitBtn;

sLabel4: TsLabel;

sLabel6: TsLabel;

Timer1: TTimer;

ExcelApplication1: TExcelApplication;

ExcelWorksheet1: TExcelWorksheet;

ExcelOLEObject1: TExcelOLEObject;

sBitBtn6: TsBitBtn;

ADOTable2: TADOTable;

sSkinProvider1: TsSkinProvider;

sLabel7: TsLabel;

sLabel8: TsLabel;

sLabel3: TsLabel;

sLabel5: TsLabel;

procedure sBitBtn1Click(Sender: TObject);

procedure sBitBtn2Click(Sender: TObject);

procedure sBitBtn3Click(Sender: TObject);

procedure sBitBtn4Click(Sender: TObject);

procedure sBitBtn5Click(Sender: TObject);

procedure ADOTable1AfterPost(DataSet: TDataSet);

procedure DataSource1DataChange(Sender: TObject; Field: TField);

procedure Timer1Timer(Sender: TObject);

procedure sBitBtn6Click(Sender: TObject);

procedure sDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.sBitBtn1Click(Sender: TObject);

begin

Form2.Show;

Adotable1.Insert;

end;

procedure TForm1.sBitBtn2Click(Sender: TObject);

begin

Form2.Show;

Adotable1.Edit;

end;

procedure TForm1.sBitBtn3Click(Sender: TObject);

begin

Adotable1.Delete;

end;

procedure TForm1.sBitBtn4Click(Sender: TObject);

begin

ADOTable1.Sort := '[name] '+'DESC';

end;

procedure TForm1.sBitBtn5Click(Sender: TObject);

begin

if sedit1.Text='' then

sdbgrid1.DataSource:=DataSource1;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add('SELECT * FROM tt WHERE '+scombobox1.text+' LIKE ''%'+sEdit1.Text+'%''');

ADOQuery1.Active:=True;

Sdbgrid1.DataSource:=DataSource2;

end;

procedure TForm1.ADOTable1AfterPost(DataSet: TDataSet);

begin

slabel5.Caption:=inttostr(sDBGrid1.DataSource.DataSet.RecordCount);

end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);

begin

slabel5.Caption:=inttostr(sDBGrid1.DataSource.DataSet.RecordCount);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

slabel6.Caption:=timetostr(now);

end;

procedure TForm1.sBitBtn6Click(Sender: TObject);

var

ExcelApp,Sheet : variant;

index,i,j:integer;

begin

ExcelApp := CreateOleObject('Excel.Application');

ExcelApp.Visible := true;

ExcelApp.WorkBooks.Add(-4167);

ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Report';

sheet:=ExcelApp.WorkBooks[1].WorkSheets['Report'];

index:=2;

for i := 1 to ADOTable1.FieldCount-1 do

sheet.cells[1, i]:= ADOTable1.Fields[i-1].DisplayName;

ADOTable1.First;

for i:=1 to ADOTable1.RecordCount do

begin

for j:=1 to ADOTable1.FieldCount do

sheet.cells[index,j]:=ADOTable1.fields[j-1].asstring;

inc(index);

ADOTable1.Next;

end;

end;

procedure TForm1.sDBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

DataCol: Integer; Column: TColumn; State: TGridDrawState);

var

StrDT: String;

DT: TDateTime;

T: TTime;

D: Integer;

begin

if (Sender as TsDBGrid).DataSource.DataSet.FieldByName('sl').AsString='Нет' then

TDBGrid(Sender).Canvas.Brush.Color:=RGB(102,255,255);

if (Sender as TsDBGrid).DataSource.DataSet.FieldByName('sl').AsString='нет' then

TDBGrid(Sender).Canvas.Brush.Color:=RGB(102,255,255);

if (Sender as TsDBGrid).DataSource.DataSet.FieldByName('sl').AsString='да'

Then TDBGrid(Sender).Canvas.Brush.Color:=RGB(102,255,102);

if (Sender as TsDBGrid).DataSource.DataSet.FieldByName('sl').AsString='Да'

Then TDBGrid(Sender).Canvas.Brush.Color:=RGB(102,255,102);

if (Sender as TsDBGrid).DataSource.DataSet.FieldByName('sl').AsString=''

Then TDBGrid(Sender).Canvas.Brush.Color:=RGB(204,255,153);

IF gdSelected IN State

Then Begin

TDBGrid(Sender).Canvas.Brush.Color:= clHighLight;

TDBGrid(Sender).Canvas.Font.Color := clHighLightText;

End;

TDBGrid(Sender).DefaultDrawColumnCell(Rect,DataCol,Column,State);

end;

function GetUserFromWindows: string;

var

UserName : string;

UserNameLen : Dword;

begin

UserNameLen := 255;

SetLength(userName, UserNameLen);

if GetUserName(PChar(UserName), UserNameLen) then

Result := Copy(UserName,1,UserNameLen - 1)

else

Result := 'Unknown';

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

slabel8.Caption:= GetUserFromWindows;

end;

end.