Сандық техника қазіргі заманғы адамның өміріне мықтап енді. Оны қолдану жанжақты және көп көлемді
жүктеу/скачать 1.24 Mb.
|
Қосымша 1Программаның листингі Текст модуля Unit1.pas unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls, ComObj, Menus, Buttons, word2000, Excel2000; type TMainForm = class(TForm) //Стандартные элементы класса BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn4: TBitBtn; BitBtn5: TBitBtn; BitBtn3: TBitBtn; BitBtn6: TBitBtn; BitBtn7: TBitBtn; BitBtn8: TBitBtn; Label1: TLabel; MainMenu1: TMainMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; N8: TMenuItem; N9: TMenuItem; N10: TMenuItem; N11: TMenuItem; N12: TMenuItem; N13: TMenuItem; N14: TMenuItem; N15: TMenuItem; N16: TMenuItem; N17: TMenuItem; BitBtn9: TBitBtn; BitBtn10: TBitBtn; BitBtn11: TBitBtn; BitBtn12: TBitBtn; BitBtn13: TBitBtn; N18: TMenuItem; N19: TMenuItem; BitBtn14: TBitBtn; //Стандартные методы класса procedure Button7Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure BitBtn5Click(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitBtn6Click(Sender: TObject); procedure BitBtn7Click(Sender: TObject); procedure BitBtn8Click(Sender: TObject); //Пользовательские процедуры procedure ExportDBGrid(DBGrid:TDBGrid; toExcel: Boolean; s:string); procedure ExportStringGrid(var Grid:TStringGrid; toExcel: Boolean; s:string); procedure N3Click(Sender: TObject); procedure N7Click(Sender: TObject); procedure N12Click(Sender: TObject); procedure N6Click(Sender: TObject); procedure N4Click(Sender: TObject); procedure N11Click(Sender: TObject); procedure N13Click(Sender: TObject); procedure N17Click(Sender: TObject); procedure N8Click(Sender: TObject); procedure N9Click(Sender: TObject); procedure N14Click(Sender: TObject); procedure N15Click(Sender: TObject); procedure N16Click(Sender: TObject); procedure BitBtn9Click(Sender: TObject); procedure BitBtn10Click(Sender: TObject); procedure BitBtn11Click(Sender: TObject); procedure BitBtn12Click(Sender: TObject); procedure BitBtn13Click(Sender: TObject); procedure BitBtn14Click(Sender: TObject); procedure N19Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var MainForm: TMainForm; OnPrivet:boolean; implementation uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit8, Unit9, Unit12, Unit13, Unit14, Unit16, Unit17, Unit18, Unit19, Unit10; {$R *.dfm} procedure TMainForm.Button7Click(Sender: TObject); begin JalobaForm.ShowModal; end; procedure TMainForm.FormShow(Sender: TObject); begin If Not(OnPrivet) then Privet.ShowModal else Login.ShowModal; end; procedure TMainForm.BitBtn1Click(Sender: TObject); begin MenuForm.Show; end; procedure TMainForm.BitBtn2Click(Sender: TObject); begin ClientsForm.ShowModal; end; procedure TMainForm.BitBtn4Click(Sender: TObject); begin ClientBron.ShowModal; end; procedure TMainForm.BitBtn5Click(Sender: TObject); begin Sotrudniki.ShowModal; end; procedure TMainForm.BitBtn3Click(Sender: TObject); begin SchetaForm.ShowModal; end; procedure TMainForm.BitBtn6Click(Sender: TObject); begin OtchetForm.ShowModal; end; procedure TMainForm.BitBtn7Click(Sender: TObject); begin JalobaForm.ShowModal; end; procedure TMainForm.BitBtn8Click(Sender: TObject); begin Application.Terminate; end; procedure TMainForm.ExportDBGrid(DBGrid:TDBGrid; toExcel: Boolean; s:string); var bm: TBookmark; col, row: Integer; sline: string; mem: TMemo; ExcelApp: Variant; begin Screen.Cursor := crHourglass; DBGrid.DataSource.DataSet.DisableControls; bm := DBGrid.DataSource.DataSet.GetBookmark; DBGrid.DataSource.DataSet.First; // создаём объект Excel if toExcel then begin ExcelApp := CreateOleObject('Excel.Application'); ExcelApp.WorkBooks.Add; ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Grid Data'; end; // Сперва отправляем данные в memo // работает быстрее, чем отправлять их напрямую в Excel mem := TMemo.Create(Self); mem.Visible := false; mem.Parent := MainForm; mem.Clear; sline := ''; // добавляем информацию для имён колонок for col := 0 to DBGrid.FieldCount-1 do if DBGrid.Columns[col].Visible=True then sline := sline + DBGrid.Columns[col].Title.Caption + #9; sline:=copy(sline,0,Length(sline)-1); mem.Lines.Add(sline); // получаем данные из memo for row := 0 to DBGrid.DataSource.DataSet.RecordCount-1 do begin sline := ''; for col := 0 to DBGrid.FieldCount-1 do if DBGrid.Columns[col].Visible=True then sline := sline + DBGrid.Fields[col].AsString + #9; sline:=copy(sline,0,Length(sline)-1); mem.Lines.Add(sline); DBGrid.DataSource.DataSet.Next; end; // копируем данные в clipboard mem.SelectAll; mem.CopyToClipboard; // если необходимо, то отправляем их в Excel // если нет, то они уже в буфере обмена if toExcel then begin ExcelApp.Range['A1:A1'].Value:=s; ExcelApp.Range['A3:A3'].Select; ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste; ExcelApp.Visible := true; ExcelApp.Selection.Columns.AutoFit; ExcelApp.Selection.Borders[xlEdgeBottom].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeTop].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeLeft].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeRight].LineStyle:=-4119; end; DBGrid.DataSource.DataSet.GotoBookmark(bm); DBGrid.DataSource.DataSet.FreeBookmark(bm); DBGrid.DataSource.DataSet.EnableControls; Screen.Cursor := crDefault; end; procedure TMainForm.ExportStringGrid(var Grid:TStringGrid; toExcel: Boolean; s:string); var bm: TBookmark; col, row: Integer; sline: string; mem: TMemo; ExcelApp: Variant; begin Screen.Cursor := crHourglass; // создаём объект Excel if toExcel then begin ExcelApp := CreateOleObject('Excel.Application'); ExcelApp.WorkBooks.Add; ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Grid Data'; end; // Сперва отправляем данные в memo // работает быстрее, чем отправлять их напрямую в Excel mem := TMemo.Create(Self); mem.Visible := false; mem.Parent := MainForm; mem.Clear; sline := ''; // добавляем информацию для имён колонок { for col := 0 to Grid.FieldCount-1 do if Grid.Columns[col].Visible=True then sline := sline + Grid.Columns[col].Title.Caption + #9; sline:=copy(sline,0,Length(sline)-1); mem.Lines.Add(sline); } // получаем данные из memo for row := 0 to Grid.RowCount-1 do begin sline := ''; for col := 0 to Grid.ColCount-1 do sline := sline + Grid.Cells[col,row] + #9; sline:=copy(sline,0,Length(sline)-1); mem.Lines.Add(sline); end; // копируем данные в clipboard mem.SelectAll; mem.CopyToClipboard; // если необходимо, то отправляем их в Excel // если нет, то они уже в буфере обмена if toExcel then begin ExcelApp.Range['A1:A1'].Value:=s; ExcelApp.Range['A1:AF100'].Select; ExcelApp.Selection.NumberFormat:='@'; ExcelApp.Range['A3:A3'].Select; ExcelApp.Workbooks[1].WorkSheets['Grid Data'].Paste; ExcelApp.Visible := true; ExcelApp.Selection.Columns.AutoFit; ExcelApp.Selection.Borders[xlEdgeBottom].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeTop].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeLeft].LineStyle:=-4119; ExcelApp.Selection.Borders[xlEdgeRight].LineStyle:=-4119; ExcelApp.Selection.NumberFormat:='@'; end; {Grid.DataSource.DataSet.GotoBookmark(bm); Grid.DataSource.DataSet.FreeBookmark(bm); Grid.DataSource.DataSet.EnableControls;} Screen.Cursor := crDefault; end; procedure TMainForm.N3Click(Sender: TObject); begin Bluda.Show; end; procedure TMainForm.N7Click(Sender: TObject); begin Sostav.ShowModal; end; procedure TMainForm.N12Click(Sender: TObject); begin Sotrudniki2.ShowModal; end; procedure TMainForm.N6Click(Sender: TObject); begin Products.ShowModal; end; procedure TMainForm.N4Click(Sender: TObject); begin Razdel.ShowModal; end; procedure TMainForm.N11Click(Sender: TObject); begin Sotrudniki.ShowModal; end; procedure TMainForm.N13Click(Sender: TObject); begin Doljnosti.ShowModal; end; procedure TMainForm.N17Click(Sender: TObject); begin MenuForm.ShowModal; end; procedure TMainForm.N8Click(Sender: TObject); begin ClientsForm.ShowModal; end; procedure TMainForm.N9Click(Sender: TObject); begin ClientBron.ShowModal; end; procedure TMainForm.N14Click(Sender: TObject); begin SchetaForm.ShowModal; end; procedure TMainForm.N15Click(Sender: TObject); begin OtchetForm.ShowModal; end; procedure TMainForm.N16Click(Sender: TObject); begin JalobaForm.ShowModal; end; procedure TMainForm.BitBtn9Click(Sender: TObject); begin Bluda.ShowModal; end; procedure TMainForm.BitBtn10Click(Sender: TObject); begin Razdel.ShowModal; end; procedure TMainForm.BitBtn11Click(Sender: TObject); begin Products.ShowModal; end; procedure TMainForm.BitBtn12Click(Sender: TObject); begin Sostav.ShowModal; end; procedure TMainForm.BitBtn13Click(Sender: TObject); begin Sotrudniki2.ShowModal; end; procedure TMainForm.BitBtn14Click(Sender: TObject); begin Doljnosti.ShowModal; end; procedure TMainForm.N19Click(Sender: TObject); begin EditLogin.showModal; end; end. Текст модуля Unit2.pas unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls, ComObj, Menus, Buttons, word2000, Excel2000, ADODB; type TMenuForm = class(TForm) DataSource1: TDataSource; DBGrid1: TDBGrid; Edit1: TEdit; DateTimePicker1: TDateTimePicker; PopupMenu1: TPopupMenu; N1: TMenuItem; N2: TMenuItem; Label1: TLabel; Label2: TLabel; ComboBox1: TComboBox; Label5: TLabel; Label6: TLabel; ComboBox2: TComboBox; Label7: TLabel; CheckBox1: TCheckBox; GroupBox1: TGroupBox; Edit4: TEdit; Label11: TLabel; Button6: TButton; BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; BitBtn4: TBitBtn; Button1: TButton; ADOConnection1: TADOConnection; ADOTable1: TADOTable; ADOQuery1: TADOQuery; ADOTable2: TADOTable; BitBtn5: TBitBtn; ADOQuery2: TADOQuery; Button2: TButton; //Стандартные процедуры procedure FormActivate(Sender: TObject); procedure DateTimePicker1Change(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure ComboBox1Change(Sender:TObject); procedure Button3Click(Sender: TObject); procedure Edit2KeyPress(Sender: TObject; var Key: Char); procedure Button6Click(Sender: TObject); procedure ComboBox5Change(Sender: TObject); procedure FormShow(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure Button1Click(Sender: TObject); //Пользовательские процедуры function UpdateAp(s:string):string; procedure ToWord(DataSet:TDataSet; Title, FlagCol:string); Procedure Find(var s:string); procedure Requery(); Function DateToAmer(Dat:TDate):string; procedure BitBtn5Click(Sender: TObject); procedure ComboBox2Change(Sender: TObject); function IndexBluda:integer; procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var MenuForm: TMenuForm; UpdateFlag:boolean; StringID, ss:String; ID, V_ID:integer; implementation uses Export, Unit1, Unit11; {$R *.dfm} //procedure TMenuForm.Button1Click(Sender: TObject); // Процедура заносит данные в таблицу function TMenuForm.DateToAmer(Dat:TDate):string; var SDate, SDate2:String; i:integer; begin SDate:=DateToStr(Dat); SDate2:=SDAte; SDate2[1]:=SDAte[4]; SDate2[2]:=SDAte[5]; SDate2[4]:=SDAte[1]; SDate2[5]:=SDAte[2]; For i:=1 to Length(Sdate2) do if SDate2[i]='.' then Sdate2[i]:='/'; Result:=Sdate2; end; function TMenuForm.IndexBluda:integer; begin Podbor.ShowModal; Result:=ID; end; procedure TMenuForm.Requery(); //Эта процедура обновляет вид таблицы на форме var s, sortirovka:string; Vid_ID:integer; begin ADOQuery1.Active:=False; ADOTable2.Active:=True; ADOTable2.First; ADOTable2.Locate('Vid',ComboBox1.Text, [loPartialKey]); Vid_ID:=ADOTable2.FieldByName('Id').AsInteger; If ComboBox1.Text='Все' then //Если выводятся данные по всем видам меню, то ищем данные по дате begin //Edit4.Text:=DateToStr(ADOQuery1.Parameters.ParamByName('D').Value); s:='SELECT a.Id, a.Data, b.Vid, a.topp, c.Nazvanie from Menu as a, Vidy_Menu as b, Bluda as c WHERE a.Vid=B.id AND a.bludo=c.id AND a.data=#'+DateToAmer(DateTimePicker1.Date)+'#'; end else //Если указан конкретный вид меню, данные выводим только по нему s:='SELECT a.Id, a.Data, b.Vid, a.topp, c.Nazvanie from Menu as a, Vidy_Menu as b, Bluda as c WHERE a.Vid=B.id AND a.bludo=c.id And B.Id='+IntToStr(Vid_Id)+' AND a.data=#'+DateToAmer(DateTimePicker1.Date)+'#'; ss:=s; //Edit1.Text:=s; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add(s); ADOQuery1.Active:=True; end; procedure TMenuForm.FormActivate(Sender: TObject); var i:integer; begin //Обновляем вид таблицы при загрузке формы ComboBox1.Items.Clear; ComboBox2.Items.Clear; ADOTable2.Active:=True; ADOTable2.First; ComboBox1.Items.Add('Все'); for i:=1 to ADOTable2.RecordCount do begin ComboBox1.Items.Add(ADOTable2.FieldByName('Vid').AsString); ComboBox2.Items.Add(ADOTable2.FieldByName('Vid').AsString); ADOTable2.Next; end; ComboBox2.ItemIndex:=0; ADOConnection1.Connected:=False; ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+Copy(Application.ExeName,0,Length(Application.ExeName)-11)+'restoran.mdb;Mode=ReadWrite;Persist Security Info=False'; ADOConnection1.Connected:=True; Requery; end; procedure TMenuForm.ToWord(DataSet:TDataSet; Title, FlagCol:string); //Универсальная процедура экспорта таблицы в Word //Датасет - наша Кесте, тайтл - заголовок таблицы, ФлагКол - указатель на колонки //таблицы, которые нужно выводить, в виде "001001", где 0 - выводим колонку, 0 - не выводим var WordApp, NewDoc, WordTable: OLEVariant; tformat, tappbrd: OleVariant; iRows, iCols, iGridRows, jGridCols, jRoWRoW,i: Integer; begin try //Загружаем Word WordApp := CreateOleObject('Word.Application'); except Exit; end; WordApp.Visible := True; //Делаем его видимым NewDoc := WordApp.Documents.Add; //Создаем новый документ //Вставляем заголовок таблицы NewDoc.Range(EmptyParam,EmptyParam).InsertBefore(Title); //NewDoc.Range(EmptyParam,EmptyParam).InsertBefore('Меню на: '+DateToStr(DateTimePicker1.Date)); WordApp.Selection.Endkey(); // Переходим в конец документа iRows := DataSet.Fields.Count; //Количество столбцов в таблице iCols := DataSet.RecordCount+1; //Количество строк jRoWRow:=0; for i:=0 to (length(FlagCol)) do // Перебираем каждый столбец if FlagCol[i]='1' then jRoWRoW:=jRowRow+1;//Узнаем количество активных столбцов WordTable := NewDoc.Tables.Add(WordApp.Selection.Range, iCols, jRoWRoW); jRoWRow:=0; DataSet.First; WordTable.Cell(1, 1).Range.Text :='Наименование'; WordTable.Cell(1, 2).Range.Text :='Описание'; WordTable.Cell(1, 3).Range.Text :='Цена'; WordTable.Cell(1, 4).Range.Text :='Грамм'; WordTable.Cell(1, 5).Range.Text :='Раздел'; for iGridRows := 1 to iRows do //Перебираем столбцы if FlagCol[iGridRows]='1' then //Если столбец отмечен как активный.... begin DataSet.First; jRoWRoW:=jRoWRoW+1; for jGridCols := 2 to iCols do begin WordTable.Cell(jGridCols, jRoWRoW).Range.Text := //.. то выводим все данные из него (DataSet.Fields[iGridRows-1].AsString); DataSet.Next; end; end; NewDoc.Tables.Item(1).Columns.AutoFit; tformat := wdTableFormatElegant; tappbrd := wdTableFormatApplyBorders; i := 1; NewDoc.Tables.Item(i).AutoFormat(tformat, tappbrd, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); //Обнуляем ставшие ненужными переменные WordApp := Unassigned; NewDoc := Unassigned; WordTable := Unassigned; end; procedure TMenuForm.DateTimePicker1Change(Sender: TObject); begin Requery(); end; procedure TMenuForm.N1Click(Sender: TObject); // Процедура срабатывает при выборе "Изменить" в контекстном меню компонента DBGrid var s:string; begin UpdateFlag:=True; // Делаем ативным флаг обновления BitBtn4.Caption:='Обновить элемент'; If DBGrid1.Fields[3].AsString='Да' then CheckBox1.Checked:=true else CheckBox1.Checked:=False; ComboBox2.Text:= DBGrid1.Fields[4].AsString; // Выводим все значения этого столбца в соответствующие компоненты Edit1.Text:=DBGrid1.Fields[2].AsString; StringID:=DBGrid1.Fields[0].AsString; end; procedure TMenuForm.N2Click(Sender: TObject); // Процедура удаления из таблицы var s:string; begin ADOQuery2.Active:=False; ADOQuery2.SQL.Clear; // Удаляется строка в которой ID равен ID текущей отмеченной строки s:='DELETE FROM menu WHERE ID='+DBGrid1.Fields[0].AsString; ADOQuery2.SQL.Add(s); ADOQuery2.ExecSQL; Requery(); end; procedure TMenuForm.ComboBox1Change(Sender: TObject); // Просто обновляем форму при смене значения в комбобоксе begin Requery(); end; function TMenuForm.UpdateAp(s:string):string; //Эта процедура дублирует знаки " в запросах, иначе SQL неправильно прочитает запрос var i:integer; var s1,s2, m:string; begin i:=0; While i<>Length(s) do begin i:=i+1; if s[i]='"' then begin s1:=Copy(s,0,i-1); s2:=Copy(s,i,length(s)-i+1); s:=s1+'"'+s2; i:=i+1; end; m:=s[i]; end; result:=s; end; procedure TMenuForm.Button3Click(Sender: TObject); begin //Простая очистка компонентов формы Edit1.Clear; ComboBox2.Text:='Все'; Edit1.SetFocus; end; procedure TMenuForm.Edit2KeyPress(Sender: TObject; var Key: Char); //Не хотелось бы, чтобы программа выдала ошибку если вы введете не числовые значения begin if Not (Key In['0'..'9']) then begin ShowMessage('Вводите только числовые значения!'); Key := #0; end; end; procedure TMenuForm.Button6Click(Sender: TObject); var i:integer; s:string ; begin s:=Edit4.Text; Find(s); end; Procedure TMenuForm.Find(var s:string); var Zapros:string; begin zapros:='SELECT a.Id, a.Data, b.Vid, a.topp, c.Nazvanie from Menu as a, Vidy_Menu as b, Bluda as c WHERE a.Vid=B.id AND a.bludo=c.id AND a.data=#'+DateToAmer(DateTimePicker1.Date)+'# AND c.Nazvanie Like "%'+s+'%"'; ss:=zapros; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add(Zapros); ADOQuery1.Active:=True; end; procedure TMenuForm.ComboBox5Change(Sender: TObject); begin Requery() end; procedure TMenuForm.FormShow(Sender: TObject); begin Requery(); end; procedure TMenuForm.BitBtn1Click(Sender: TObject); begin MainForm.ExportDBGrid(DBGrid1,true, 'Меню на '+DateToStr(DateTimePicker1.Date)); end; procedure TMenuForm.BitBtn2Click(Sender: TObject); begin //ToWord(Query1, 'Меню на: '+DateToStr(DateTimePicker1.Date),'000011111'); end; procedure TMenuForm.BitBtn3Click(Sender: TObject); begin MenuForm.Close; MainForm.Show; end; procedure TMenuForm.BitBtn4Click(Sender: TObject); var s, top, dat:string; begin ADOTable2.Active:=True; ADOTable1.Active:=True; ADOTable2.First; ADOTable2.Locate('Vid',ComboBox2.Text, [loPartialKey]); V_ID:=ADOTable2.FieldByName('Id').AsInteger; ADOTable1.First; if Not(ADOTable1.Locate('Nazvanie',Edit1.Text, [loPartialKey]))or (V_ID=0) then ShowMessage('Выберите блюдо и вид меню!') else begin ID:= ADOTable1.FieldByName('ID').AsInteger; If UpdateFlag=False then //Если не задан режим обновления, то данные в таблицу ЗАНОСЯТСЯ begin Dat:=DateToStr(DateTimePicker1.Date); If CheckBox1.Checked then top:='Да' else top:='Нет'; s:='INSERT INTO menu (Vid, Topp, Data, Bludo ) VALUES ('+IntToStr(V_ID)+', '''+top+''',#'+DateToAmer(DateTimePicker1.Date)+'#,'+IntToStr(ID)+')'; ss:=s; //Memo1.Text:=s; UpdateFlag:=False; end else //Если задан режим обновления, то данные в талице ОБНОВЛЯЮТСЯ begin If CheckBox1.Checked then top:='Да' else top:='Нет'; //Динамически формируем запрос на обновление s:='UPDATE menu SET Vid='+IntToStr(V_ID)+',Topp='''+top+''',Data=#'+DateToAmer(DateTimePicker1.Date)+'#, Bludo='+IntToStr(ID)+' WHERE ID='+StringID; //Memo1.Text:=s; BitBtn1.Caption:='Занести элемент'; //Меняем название на кнопке (раньше было "Обновляем.." UpdateFlag:=False; end; ADOQuery2.Active:=False; ADOQuery2.SQL.Clear; ADOQuery2.SQL.Add(s); ADOQuery2.ExecSQL; Requery; ComboBox2.ItemIndex:=0; Edit1.Text:=''; end; end; procedure TMenuForm.Button1Click(Sender: TObject); begin Requery(); ADOQuery1.Sort:='Nazvanie'; end; procedure TMenuForm.BitBtn5Click(Sender: TObject); begin Podbor.ShowModal; end; procedure TMenuForm.ComboBox2Change(Sender: TObject); begin ADOTable2.Active:=True; ADOTable2.First; ADOTable2.Locate('Vid',ComboBox2.Text, [loPartialKey]); V_ID:=ADOTable2.FieldByName('Id').AsInteger; end; procedure TMenuForm.Button2Click(Sender: TObject); begin Requery; Edit4.Clear; end; procedure TMenuForm.FormCreate(Sender: TObject); begin ADOConnection1.Connected:=False; ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+Copy(Application.ExeName,0,Length(Application.ExeName)-11)+'restoran.mdb;Mode=ReadWrite;Persist Security Info=False'; ADOConnection1.Connected:=True; end; end. Текст модуля Unit3.pas unit Unit3; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, DB, DBTables, ComCtrls, StdCtrls, ComObj, Menus, Buttons, word2000, Excel2000, ADODB; type TClientsForm = class(TForm) DataSource1: TDataSource; DBGrid1: TDBGrid; Label1: TLabel; Edit1: TEdit; Label2: TLabel; ComboBox1: TComboBox; Button1: TButton; Button3: TButton; PopupMenu1: TPopupMenu; N1: TMenuItem; N2: TMenuItem; BitBtn1: TBitBtn; BitBtn2: TBitBtn; Button4: TButton; GroupBox1: TGroupBox; Edit2: TEdit; Label3: TLabel; Button5: TButton; BitBtn3: TBitBtn; ADOQuery1: TADOQuery; ADOTable1: TADOTable; ADOQuery2: TADOQuery; //Стандартные процедуры procedure Button1Click(Sender: TObject); procedure N1Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Button3Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); //Пользовательские процедуры Procedure Find(s:string); Procedure Requery(); procedure ToWord(DataSet:TDataSet; Title, FlagCol:string); private { Private declarations } public { Public declarations } end; var ClientsForm: TClientsForm; UpdateFlag:boolean; StringID:String; implementation uses Unit2, Unit1, Unit4; {$R *.dfm} procedure TClientsForm.Button1Click(Sender: TObject); var s:string; begin If UpdateFlag = False then begin ADOTable1.Append; ADOTable1.FieldByName('Name').AsString:=Edit1.Text; ADOTable1.FieldByName('VIP').AsString:=ComboBox1.Text; ADOTable1.Append; end else begin s:='UPDATE clients SET Name="'+Edit1.Text+'", VIP="'+ComboBox1.Text+'" WHERE ID='+StringID; ADOQuery1.Active:=False; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add(s); ADOQuery1.ExecSQL; Button1.Caption:='Занести элемент'; //Меняем название на кнопке (раньше было "Обновляем.." UpdateFlag:=False; end; Requery(); end; procedure TClientsForm.N1Click(Sender: TObject); begin UpdateFlag:=True; StringID:=DBGrid1.Fields[0].AsString; Edit1.Text:=DBGrid1.Fields[1].AsString; ComboBox1.Text:=DBGrid1.Fields[2].AsString; Button1.Caption:='Изменить'; end; Procedure TClientsForm.Requery(); begin ADOQuery2.Active:=False; ADOQuery2.Active:=True; Edit1.Text:=DBGrid1.Fields[1].AsString; ComboBox1.Text:=DBGrid1.Fields[2].AsString; end; procedure TClientsForm.FormActivate(Sender: TObject); begin Requery(); end; procedure TClientsForm.Button3Click(Sender: TObject); begin ClientBron.ShowModal; end; procedure TClientsForm.N2Click(Sender: TObject); var s:string; begin StringID:=DBGrid1.Fields[0].AsString; s:='DELETE FROM clients WHERE ID='+StringID; ADOQuery1.Active:=False; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add(s); ADOQuery1.ExecSQL; Requery(); end; procedure TClientsForm.Button4Click(Sender: TObject); var s:string; begin StringID:=DBGrid1.Fields[0].AsString; s:='DELETE FROM clients WHERE ID='+StringID; ADOQuery1.Active:=False; ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add(s); ADOQuery1.ExecSQL; Requery(); end; procedure TClientsForm.ToWord(DataSet:TDataSet; Title, FlagCol:string); //Универсальная процедура экспорта таблицы в Word //Датасет - наша Кесте, тайтл - заголовок таблицы, ФлагКол - указатель на колонки //таблицы, которые нужно выводить, в виде "001001", где 0 - выводим колонку, 0 - не выводим var WordApp, NewDoc, WordTable: OLEVariant; tformat, tappbrd: OleVariant; iRows, iCols, iGridRows, jGridCols, jRoWRoW,i: Integer; begin try //Загружаем Word WordApp := CreateOleObject('Word.Application'); except Exit; end; WordApp.Visible := True; //Делаем его видимым NewDoc := WordApp.Documents.Add; //Создаем новый документ //Вставляем заголовок таблицы NewDoc.Range(EmptyParam,EmptyParam).InsertBefore(Title); //NewDoc.Range(EmptyParam,EmptyParam).InsertBefore('Меню на: '+DateToStr(DateTimePicker1.Date)); WordApp.Selection.Endkey(); // Переходим в конец документа iRows := DataSet.Fields.Count; //Количество столбцов в таблице iCols := DataSet.RecordCount+1; //Количество строк jRoWRow:=0; for i:=0 to (length(FlagCol)) do // Перебираем каждый столбец if FlagCol[i]='1' then jRoWRoW:=jRowRow+1;//Узнаем количество активных столбцов WordTable := NewDoc.Tables.Add(WordApp.Selection.Range, iCols, jRoWRoW); jRoWRow:=0; DataSet.First; WordTable.Cell(1, 1).Range.Text :='Клиент'; WordTable.Cell(1, 2).Range.Text :='VIP'; for iGridRows := 1 to iRows do //Перебираем столбцы if FlagCol[iGridRows]='1' then //Если столбец отмечен как активный.... begin DataSet.First; jRoWRoW:=jRoWRoW+1; for jGridCols := 2 to iCols do begin WordTable.Cell(jGridCols, jRoWRoW).Range.Text := //.. то выводим все данные из него (DataSet.Fields[iGridRows-1].AsString); DataSet.Next; end; end; NewDoc.Tables.Item(1).Columns.AutoFit; tformat := wdTableFormatElegant; tappbrd := wdTableFormatApplyBorders; i := 1; NewDoc.Tables.Item(i).AutoFormat(tformat, tappbrd, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); //Обнуляем ставшие ненужными переменные WordApp := Unassigned; NewDoc := Unassigned; WordTable := Unassigned; end; Procedure TClientsForm.Find(s:string); var Zapros:string; begin zapros:='Select * From Clients where Name Like "%'+s+'%"'; ADOQuery2.Active:=False; ADOQuery2.SQL.Clear; ADOQuery2.SQL.Add(Zapros); ADOQuery2.Active:=True; end; procedure TClientsForm.BitBtn1Click(Sender: TObject); begin MainForm.ExportDBGrid(DBGrid1, true, 'Все клиенты'); end; procedure TClientsForm.BitBtn2Click(Sender: TObject); begin ToWord(ADOTable1, 'Список клиентов', '011'); end; procedure TClientsForm.Button5Click(Sender: TObject); begin Find(Edit2.Text); end; procedure TClientsForm.FormCreate(Sender: TObject); begin UpdateFlag:=False; end; procedure TClientsForm.BitBtn3Click(Sender: TObject); begin ClientsForm.Close; MainForm.Show; end; end. жүктеу/скачать 1.24 Mb. Достарыңызбен бөлісу:
|