CASE средство Designer/2000

  //Заполняем таблицу списка объектов

  Table1:=WordDocument1.Tables.Item(1); //связываем  имя Table1 с первой таблицей документа

  //WordDocument1.Tables - это массив таблиц  документа (тип Tables), а  WordDocument1.Tables.Item(i) - i-ая таблица

 

  Replace:=true; // параметр, задающий режим  замены

  FindText:='#1'; // что меняем

  ReplaceWith:='с '+datetostr(dtp1.Date)+' по '+datetostr(dtp2.Date); // на что меняем

  WordDocument1.Range.Find.Execute(FindText,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,

                EmptyParam,EmptyParam,ReplaceWith,Replace,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

 

 

 

  dm.temp.Active:=false;

  dm.temp.CommandText:='Select adr_z,datapv_za from zil,zilci,zayavka where (id_z=id_z_zl) and (id_zl=id_zl_za) and (datav_za is Null) and (dataot_za is Null) and(datapv_za BETWEEN #'+fmain.data(dtp1.Date)+'# and #'+fmain.data(dtp2.Date)+'#)';

  dm.temp.Active:=true;

 

     i:=2;

 

    While (not dm.temp.Eof)do

      begin

      Table1.Rows.Add(EmptyParam);

      Table1.Cell(i, 1).Range.Text := dm.temp.Fields[0].AsString;

      Table1.Cell(i, 2).Range.Text := dm.temp.Fields[1].AsString;

 

      inc(i);dm.temp.next;

      end;

  Replace:=true; // параметр, задающий режим  замены

  FindText:='#2'; // что меняем

  ReplaceWith:=floattostr(summa); // на что меняем

  WordDocument1.Range.Find.Execute(FindText,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,

                EmptyParam,EmptyParam,ReplaceWith,Replace,EmptyParam,EmptyParam,EmptyParam,EmptyParam);

  Table1.Rows.Item(i).Delete;

  WordApplication1.Visible:=true; //делаем приложение MS Word видимым

  WordApplication1.Disconnect; // Разрываем связь с серверо

  end;

 

end;

 

end.

rocedure TFmain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if application.MessageBox('Вы хотите выйти из программы?','Выход из программы',mb_yesno+mb_iconquestion)=idyes then

  begin

  application.Terminate;

  end

else canclose:=false;

end;

 

procedure TFmain.N2Click(Sender: TObject);

begin

closequery;

end;

 

procedure TFmain.FormShow(Sender: TObject);

begin

if fileexists('photo.jpg') then

  begin

  image1.Picture.LoadFromFile('photo.jpg');

  end;

end;

 

function TFmain.data (data:tdatetime):string;

var g,m,d:word;

begin

decodedate(data,g,m,d);

result:=''+currtostr(m)+'/'+currtostr(d)+'/'+currtostr(g)+'';

end;

 

function TFmain.Update(rs,tab:string):boolean;

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select log_'+rs+' from '+tab+' where (id_'+rs+'='+tmp+')';

dm.temp.Active:=true;

if dm.temp.Fields[0].AsBoolean=true then

  begin

  result:=false;

  end

else

  begin

  dm.com.CommandText:='Update '+tab+' set log_'+rs+'=TRUE where id_'+rs+'='+tmp+'';

  dm.com.Execute;

  result:=true;

  end;

end;

function TFmain.Delete(rs,tab,temp:string):boolean;

begin

dm.temp.Active:=false;

dm.temp.CommandText:='Select log_'+rs+' from '+tab+' where (id_'+rs+'='+tmp+')';

dm.temp.Active:=true;

if dm.temp.Fields[0].AsBoolean=true then

  begin

  result:=false;

  end

else if application.MessageBox('Вы хотите удалить запись?','Удаление',mb_yesno+mb_iconquestion)=idyes then

  begin

  dm.com.CommandText:='Delete * from '+tab+' where (id_'+rs+'='+tmp+')';

  dm.com.Execute;

  result:=true;

  showmessage('Удаление прошло успешно');

  end;

end;

 

procedure TFmain.N4Click(Sender: TObject);

var inifile:tinifile;

dbp:string;

begin

IniFile      := TIniFile.Create(ExtractFilePath(Application.ExeName)+'options.ini');           // загрузка из фала настроек пути к базе

DBP := IniFile.ReadString('options', 'dbpath', '');

IniFile.Free;

//showmessage(dbp);

copyfile(pchar(DBP),pchar(ExtractFilePath(Application.ExeName)+'Архив\base_'+datetostr(date)+'_'+stringreplace(timetostr(time),':','.',[rfReplaceAll, rfIgnoreCase])+'.mdb'),true);

if fileexists(ExtractFilePath(Application.ExeName)+'Архив\base_'+datetostr(date)+'_'+stringreplace(timetostr(time),':','.',[rfReplaceAll, rfIgnoreCase])+'.mdb') =true then showmessage('Резервная копия создана успешно')

else showmessage('Ошибка при создании  резервной копии');

 

end;

 

procedure TFmain.N3Click(Sender: TObject);

begin

fchpass.Caption:=n3.Caption;

fchpass.ShowModal;

end;

 

procedure TFmain.N6Click(Sender: TObject);

begin

fzil.Caption:=n6.Caption;

fzil.DBGrid1.PopupMenu:=fzil.PopupMenu1;

fzil.DBGrid1.DataSource:=dm.zs;

dm.z.Active:=false;

dm.z.CommandText:='select id_z, adr_z, tdom_z, tkr_z, pl_z, lift_z from Zil';

dm.z.Active:=true;

fzil.ShowModal;

end;

 

procedure TFmain.N7Click(Sender: TObject);

begin

fzilci.Caption:=n7.Caption;

fzilci.DBGrid1.PopupMenu:=fzilci.PopupMenu1;

fzilci.DBGrid1.DataSource:=dm.zls;

dm.zl.Active:=false;

dm.zl.CommandText:='Select id_zl,fio_zl,adr_z,kv_zl from zil,zilci where (id_z=id_z_zl)';

dm.zl.Active:=true;

 

fzilci.ShowModal;

 

 

end;

 

procedure TFmain.N8Click(Sender: TObject);

begin

fremr.Caption:=n8.Caption;

fremr.DBGrid1.PopupMenu:=fremr.PopupMenu1;

fremr.DBGrid1.DataSource:=dm.rrs;

dm.rr.Active:=false;

dm.rr.CommandText:='Select id_rr,nazv_rr,st_rr,edi_rr from RemR';

dm.rr.Active:=true;

fremr.ShowModal;

end;

 

procedure TFmain.N10Click(Sender: TObject);

begin

fzayavka.Caption:=n10.Caption;

fzayavka.DBGrid1.PopupMenu:=fzayavka.PopupMenu1;

dm.za.Active:=false;

dm.za.CommandText:='Select id_za, ([adr_z]&", кв. "&[kv_zl]) as adr,soder_za,dataz_za,datapv_za from zayavka,zil,zilci where (id_z=id_z_zl) and (id_zl=id_zl_za) and (datav_za is null) and (dataot_za is null)';

dm.za.Active:=true;

fzayavka.ShowModal;

end;

 

procedure TFmain.N11Click(Sender: TObject);

begin

fVipZ.Caption:=n11.Caption;

fVipZ.DBGrid1.PopupMenu:=fVipZ.PopupMenu1;

dm.vz.Active:=false;

dm.vz.CommandText:='Select id_za, ([adr_z]&", кв. "&[kv_zl]) as adr,soder_za,datav_za, sum(st_nr) as summa from zayavka,zil,zilci,naznR '+

'where (id_z=id_z_zl) and (id_zl=id_zl_za) and (id_za=id_za_nr) and (datav_za is not NULL) GROUP BY id_za, ([adr_z]&", кв. "&[kv_zl]) ,soder_za,datav_za';

dm.vz.Active:=true;

fVipZ.ShowModal;

end;

 

procedure TFmain.N12Click(Sender: TObject);

begin

fZotk.Caption:=n12.Caption;

fZotk.DBGrid1.PopupMenu:=fZotk.PopupMenu1;

dm.otz.Active:=false;

dm.otz.CommandText:='Select id_za, ([adr_z]&", кв. "&[kv_zl]) as adr,soder_za,prich_za from zayavka,zil,zilci where (id_z=id_z_zl) and (id_zl=id_zl_za) and (dataot_za is not null)';

dm.otz.Active:=true;

fZotk.ShowModal;

end;

 

procedure TFmain.N14Click(Sender: TObject);

begin

tm:=0;

fdati.Caption:=n14.Caption;

fdati.ShowModal;

end;

 

procedure TFmain.N15Click(Sender: TObject);

begin

tm:=1;

fdati.Caption:=n15.Caption;

fdati.ShowModal;

end;

 

procedure TFmain.N16Click(Sender: TObject);

begin

tm:=2;

fdati.Caption:=n16.Caption;

fdati.ShowModal;

end;

 

procedure TFmain.N17Click(Sender: TObject);

var

 

  Template,NewTemplate,FindText, NewStr, Replace,ReplaceWith:OleVariant;

  LinkToFile,SaveWithDocument,Range:OleVariant;

  Table1: Table;

  i: integer;

  flag:boolean;

  Reg: TRegistry;

  summa:real;

 

begin

 

  //Проверяем, инсталлирован ли Word

  Reg := TRegistry.Create;

  Reg.RootKey := HKEY_CLASSES_ROOT;

  flag:=reg.KeyExists('Word.Application');

  reg.Free;

  //flag:=true;

  if flag=false then

    begin

    application.MessageBox('Word не устанволен','Отчет',mb_ok+mb_iconstop);

    exit;

    end;

 

 

  WordApplication1.Visible:=false;

  WordApplication1.Connect; // Устанавливаем связь с сервером

  //Открываем шаблон otchet.dot в Word

  Template:=ExtractFilePath(Application.EXEName)+'\Dot\Отказ.dot'; //путь к шаблону документа

  WordApplication1.Documents.Add(Template,EmptyParam,EmptyParam,EmptyParam);// создаем документ на основе шаблона

  WordDocument1.ConnectTo(WordApplication1.ActiveDocument); //Связываем компонент WordDocument1 c активным документом (т.е. с только что созданным документом)

  //Заполняем таблицу списка объектов

  Table1:=WordDocument1.Tables.Item(1); //связываем  имя Table1 с первой таблицей документа

  //WordDocument1.Tables - это массив таблиц  документа (тип Tables), а  WordDocument1.Tables.Item(i) - i-ая таблица

 

 

  dm.temp.Active:=false;

  dm.temp.CommandText:='Select adr_z,prich_za FROM zil,zilci,zayavka WHERE (id_z=id_z_zl) and (id_zl=id_zl_za) and (dataot_za is not null)';

  dm.temp.Active:=true;

 

     i:=2;

 

    While (not dm.temp.Eof)do

      begin

      Table1.Rows.Add(EmptyParam);

      Table1.Cell(i, 1).Range.Text := dm.temp.Fields[0].AsString;

      Table1.Cell(i, 2).Range.Text := dm.temp.Fields[1].AsString;

      inc(i);dm.temp.next;

      end;

 

  Table1.Rows.Item(i).Delete;

  WordApplication1.Visible:=true; //делаем приложение MS Word видимым

  WordApplication1.Disconnect; // Разрываем связь с серверо

 

end;

 

end.

procedure TFNaznR.BitBtn2Click(Sender: TObject);

begin

e1.Clear;e3.Clear; cb1.Clear;

if tm=1 then

  begin

  dm.com.CommandText:='Update naznr set log_nr=FALSE WHERE (id_nr='+tmp2+')';

  dm.com.Execute;

  end;

if id_rr<>'' then

  begin

  dm.com.CommandText:='Update RemR Set log_rr=FALSE WHERE (id_rr='+id_rr+')';

  dm.com.Execute;

  id_rr:='';

  end; 

panel1.Visible:=false;

end;

 

procedure TFNaznR.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if panel1.Visible=true then

  begin

  BitBtn2Click(Sender);

  end;

end;

 

procedure TFNaznR.N1Click(Sender: TObject);

begin

panel1.Visible:=true;

tm:=0;

e1.Clear;e3.Clear; cb1.Clear;

dm.temp.Active:=false;

dm.temp.CommandText:='Select nazv_rr from RemR';

dm.temp.Active:=true;

While not dm.temp.Eof do

  begin

  cb1.Items.Add(dm.temp.Fields[0].AsString);

  dm.temp.Next;

  end;

end;

 

procedure TFNaznR.N2Click(Sender: TObject);

begin

if dm.nr.Fields[0].AsString='' then

  begin

  showmessage('Запись для редактирования  отсутствует');

  exit;

  end;

tmp2:=dm.nr.Fields[0].AsString;tm:=1;

//******************************

if fmain.Update('nr','naznR')=false then

  begin

  showmessage('Данная запись используется  другим пользователем');

  exit;

  end;

//******************************

cb1.Clear;

dm.temp.Active:=false;

dm.temp.CommandText:='Select nazv_rr from RemR';

dm.temp.Active:=true;

While not dm.temp.Eof do

  begin

  cb1.Items.Add(dm.temp.Fields[0].AsString);

  dm.temp.Next;

  end;

 

e1.Text:=dm.nr.fieldbyname('ob_nr').AsString;

cb1.Text:=dm.nr.fieldbyname('nazv_rr').AsString;

//e2.Text:=dm.nr.fieldbyname('st_nr').AsString;

e3.text:=dm.nr.fieldbyname('st_rr_nr').AsString;

 

cb1Change(Sender);

panel1.Visible:=true;

end;

 

procedure TFNaznR.N4Click(Sender: TObject);

begin

if dm.nr.Fields[0].AsString='' then

  begin

  showmessage('Запись для редактирования  отсутствует');

  exit;

  end;

tmp2:=dm.nr.Fields[0].AsString;tm:=1;

if fmain.Delete('nr','naznR',tmp)=false then

  begin

  showmessage('Данная запись используется  другим пользователем');

  exit;

  end

else dm.nr.Requery();

end;

 

procedure TFNaznR.cb1Change(Sender: TObject);

begin

 

if id_rr<>'' then

  begin

  dm.com.CommandText:='Update RemR Set log_rr=FALSE WHERE (id_rr='+id_rr+')';

  dm.com.Execute;

  id_rr:='';

  end;

dm.temp.Active:=false;

dm.temp.CommandText:='Select id_rr,st_rr from RemR WHERE (nazv_rr="'+cb1.Text+'") and (log_rr=false)';

dm.temp.Active:=true;

if dm.temp.RecordCount=0 then

  begin

  showmessage('Текущая запись занята');

  cb1.Text:='';

  end

else

  begin

  id_rr:=dm.temp.fields[0].asstring;

  e3.Text:=dm.temp.fields[1].asstring;

  dm.com.CommandText:='Update RemR Set log_rr=TRUE WHERE (id_rr='+id_rr+')';

  dm.com.Execute;

  end;

 

end;

 

procedure TFNaznR.BitBtn1Click(Sender: TObject);

var

summa:real;

begin

if (cb1.Text='') OR (e1.Text='') then showmessage('Вы не заполнили одно или несколько полей')

else

  begin

  try

  e1.Text:=floattostr(  roundto(strtofloat(e1.Text),-2)  );

  summa:=roundto(strtofloat(e1.Text)*strtofloat(e3.Text),-2);

  except

  showmessage('Ошибка при вводе  числовых значений');

  end;

 

  if tm=0 then

    begin

    dm.temp.Active:=false;

    dm.temp.CommandText:='Select id_nr from naznR where (id_rr_nr='+id_rr+') and (id_za_nr='+tmp+')';

    dm.temp.Active:=true;

    if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

    else

      begin

      dm.com.CommandText:='Insert into naznr (id_rr_nr,st_rr_nr,ob_nr,st_nr,id_za_nr) values ('+id_rr+',"'+e3.Text+'","'+e1.Text+'","'+floattostr(summa)+'",'+tmp+')';

      dm.com.Execute;

      showmessage('Запись успешно добавлена');

      dm.nr.Requery();

      BitBtn2Click(Sender);

      end;

    end

  else

    begin

    dm.temp.Active:=false;

    dm.temp.CommandText:='Select id_nr from naznR where (id_rr_nr='+id_rr+') and (id_za_nr='+tmp+')';

    dm.temp.Active:=true;

  //if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

    //else

      begin

      dm.com.CommandText:='Update naznr SET id_rr_nr="'+id_rr+'",st_rr_nr="'+e3.Text+'",ob_nr="'+e1.Text+'",st_nr="'+floattostr(summa)+'",id_za_nr="'+tmp+'"  WHERE (id_nr='+tmp2+')';

      dm.com.Execute;

      showmessage('Запись успешно изменена');

      dm.nr.Requery();

      BitBtn2Click(Sender);

      end;

    end;

  end;

end;

 

procedure TFNaznR.N7Click(Sender: TObject);

begin

dm.nr.Active:=false;

dm.nr.CommandText:='Select id_nr,nazv_rr,edi_rr,st_rr_nr,st_rr,ob_nr,st_nr from naznR,Remr where (id_rr=id_rr_nr) and (id_za_nr='+tmp+')';

dm.nr.Active:=true;

end;

 

procedure TFNaznR.N9Click(Sender: TObject);

begin

dm.nr.Active:=false;

dm.nr.CommandText:='Select id_nr,nazv_rr,edi_rr,st_rr_nr,st_rr,ob_nr,st_nr from naznR,Remr where (id_rr=id_rr_nr) and (id_za_nr='+tmp+') ORDER BY st_nr';

dm.nr.Active:=true;

end;

 

procedure TFNaznR.N6Click(Sender: TObject);

begin

tmpc:='';

while trim(tmpc)='' do

  begin

  tmpc:=inputbox(n6.Caption,'Задайте фильтр','');

  if trim(tmpc)='' then showmessage('Задайте фильтр')

  else

    begin

    dm.nr.Active:=false;

    dm.nr.CommandText:='Select id_nr,nazv_rr,edi_rr,st_rr_nr,st_rr,ob_nr,st_nr from naznR,Remr where (id_rr=id_rr_nr) and (id_za_nr='+tmp+') and (nazv_rr like "%'+tmpc+'%")';

    dm.nr.Active:=true;

    end;

  end;

end;

 

end.

procedure TFremR.BitBtn2Click(Sender: TObject);

begin

e1.Clear;e2.Clear;e3.Clear;

if tm=1 then

  begin

  dm.com.CommandText:='Update remr set log_rr=FALSE WHERE (id_rr='+tmp+')';

  dm.com.Execute;

  end;

panel1.Visible:=false;

end;

 

procedure TFremR.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if panel1.Visible=true then

  begin

  BitBtn2Click(Sender);

  end;

end;

 

procedure TFremR.BitBtn1Click(Sender: TObject);

begin

if (e1.Text='') or (e2.Text='') or (e3.Text='') then showmessage('Вы не заполнили одно или несколько полей')

else

  begin

  try

  e2.Text:=floattostr(roundto(strtofloat(e2.Text),-2));

  except

  showmessage('Некорректный ввод числовых  значений');

  exit;

  end;

 

  if tm=0 then

    begin

    dm.temp.Active:=false;

    dm.temp.CommandText:='Select id_rr from remr where (nazv_rr="'+e1.Text+'")';

    dm.temp.Active:=true;

    if dm.temp.RecordCount>0 then showmessage('Подобная запись уже существует')

    else

      begin

      dm.com.CommandText:='Insert into remr (nazv_rr,st_rr,edi_rr) values ("'+e1.Text+'","'+e2.Text+'","'+e3.Text+'")';

      dm.com.Execute;

      dm.temp.Active:=false;

      dm.temp.CommandText:='Select max(id_rr) from remr';

      dm.temp.Active:=true;

      tmpC:=dm.temp.Fields[0].AsString;

      dm.com.CommandText:='Insert into rCen (id_rr_rc,cena_rc,data_rc) values ('+tmpC+',"'+e2.Text+'","'+datetostr(date)+'")';

      dm.com.Execute;

      showmessage('Запись успешно добавлена');

      dm.rr.Requery();

      BitBtn2Click(Sender);

      end;

    end

  else

    begin

    dm.temp.Active:=false;

    dm.temp.CommandText:='Select id_rr from remr where (nazv_rr="'+e1.Text+'")';

    dm.temp.Active:=true;

    if (dm.temp.RecordCount>0) and (tmp<>dm.temp.Fields[0].asstring) then showmessage('Подобная запись уже существует')

    else

      begin

      dm.com.CommandText:='Update remr SET nazv_rr="'+e1.Text+'",st_rr="'+e2.Text+'",edi_rr="'+e3.Text+'" WHERE (id_rr='+tmp+')';

      dm.com.Execute;

 

      if tmpc<>e2.Text then

        begin

        dm.temp.Active:=false;

        dm.temp.CommandText:='Select id_rc from rCen WHERE (id_rr_rc='+tmp+') and (data_rc = #'+fmain.data(date)+'#)';

        dm.temp.Active:=true;

        if dm.temp.RecordCount=0 then

          begin

          dm.com.CommandText:='Insert into rCen (id_rr_rc,cena_rc,data_rc,ocena_rc) values ('+tmp+',"'+e2.Text+'","'+datetostr(date)+'","'+tmpc+'")';