home *** CD-ROM | disk | FTP | other *** search
Wrap
// verze pro 32bitovou WinBase602 4.0 (jin² I_deklar) // 1) oprava ve fci DoplnJmeno v p°φpad∞ jmen Üablon < 8 znak∙ // 2) na zaΦßtku se zeptß na skupinu // 3) oprava v SELECTU p°i exportu v TDT // 4) volit. varianta pro OEM {******************************************************************} {***** aplikace Adresß° firem v. 3.32.05 15.5.1996 *****} {******************************************************************} {$I I_deklar} //32 {$I I_sestavd} {$I I_expimp} {$I I_udrzba} {$I I_kontakty} {$I I_tisk} {$I I_mailmerg} {$I I_prava} procedure Synchronizace(vzor,cil : window_id); {**************************************} var irec,erec,cilnum : integer; curvzor,curcil : cursor; fl : short; s1,s2 : string[20]; begin if Get_view_pos(vzor, irec, erec) then if Get_fcursor(vzor, curvzor, fl) then if Get_fcursor(cil, curcil, fl) then if not Super_recnum(curvzor, curcil, erec, cilnum) then begin Set_ext_pos(cil, cilnum, -1); Pick_window(cil); end; end; procedure Prepnuti; {**************************************} {synchronizace aktußlnφch zßznam∙ pohledu Pfirma a Pseznam, tlaΦφtko F6} begin if (Active_view = id_sez) then begin // v pohledu Pseznam if (id = 0) then begin Open_view('*Pfirma',curmain,0,0,0,id); SetWindowText(id,s2); end; Synchronizace(id_sez,id) end else if (Active_view = id) then begin // v pohledu Pfirma if (id_sez = 0) then begin Open_view('*Pseznam',curmain,0,0,0,id_sez); SetWindowText(id_sez,s4); end; Synchronizace(id,id_sez); end end; procedure UplatnitDotaz; {**************************************} {definice dotazu v prom. dotaz se pou₧ije pro kurzor curmain} var pocetx : integer; pomshort : short; begin if id > 0 then Send_message(id,1599,0,0); // odstran∞nφ p°φpadnΘho QBE dotazu if id_sez > 0 then Send_message(id_sez,1599,0,0); if not Close_cursor(curmain) then // zav°φt star² kurzor if not Open_sql_cursor(curmain,dotaz) then // otev°φt ho s novou definicφ TADY begin if id>0 then begin Set_fcursor(id,curmain,-1); // je-li pohled otev°en, vnutit mu nov² kurzor end; if id_sez>0 then begin Set_fcursor(id_sez,curmain,-1); end; Err_mask(true); // aby nßsledujφcφ mo₧nß chyba neskonΦila program.. pomshort := curmain[0].cislo; // rychlΘ zjiÜt∞nφ, mß-li kurzor alespo≥ jeden zßznam if Sz_error = 131 then Info_box("Nelze","Podmφnce nevyhovuje ₧ßdn² zßznam !"); // chyba Zßznam mimo tabulku Err_mask(false); end else Signalize; end; procedure VyberSkupinu; {**************************************} var id_vs : window_id; begin zrusitAkci := true; vybrat := true; Open_view('*Vyberskup',no_redir,0,0,0,id_vs); repeat Peek_message until id_vs=0; if not zrusitAkci then begin if vsechnysk then begin s2 := 'VÜechny skupiny'; s4 := 'P°ehled firem vÜech skupin'; dotaz := 'SELECT * FROM Tfirma'; end else begin nazskup := Skupiny[skup].nazev; s2 := 'Skupina: '+nazskup; s4 := 'P°ehled firem skupiny: '+nazskup; dotaz := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup); end; UplatnitDotaz; DoplnitTexty; if id > 0 then begin SetWindowText(id,s2); Reset_view(id,-1,reset_controls); end; if id_sez > 0 then begin SetWindowText(id_sez,s4); Reset_view(id,-1,reset_controls); end; end; end; procedure Kopie; {**************************************} {Vytvo°enφ kopie aktußlnφho zßznamu, p°enßÜejφ se ·daje o firm∞, nikoliv personßlnφ ·daje} type mult = array[1..10] of string[20]; var i : short; rr,reci,rece : integer; sk : short; fir,fir2,ulic,mest : string[50]; ps : string[6]; st : string[30]; dc : string[13]; ic : string[8]; p1,p2,p3,p4,p5,p6,p7,p8 : boolean; tel,faxx : mult; maill : array[1..5] of string[30]; bank : array[1..5] of string[50]; cf : cursor; pom,cisloZaznamu : integer; cislox,pomcislok : integer; idkop : window_id; begin Send_message(id_sez,1599,0,0); Send_message(id,1599,0,0); // odznaΦenφ p°φp. QBE dotazu if Active_view = id_sez then Prepnuti; // p°epnutφ do pohledu Pfirma if Get_view_pos(id,reci,rece) then begin // zjiÜt∞nφ Φφsla kopφrovanΘho zßznamu Get_fcursor(id,cf,nil); pomcislok := cf; Translate(cf,rece,0,cisloZaznamu); // p°epoΦet na Φφslo zßznamu v tabulce, abych se nemusel starat o beztypovy kurzor cf Set_cursor(1); with Tfirma[cisloZaznamu] do begin // naΦtenφ ·daj∙ do prom∞nn²ch sk := skupina; fir := firma; fir2 := firma2; ulic := ulice; mest := mesto; ps := psc; st := stat; ic := ico; dc := dic; p1 := prep1; p2 := prep2; p3 := prep3; p4 := prep4; p5 := prep5; p6 := prep6; p7 := prep7; p8 := prep8; for i := 1 to 10 do tel[i] := telefon[i-1]; for i := 1 to 10 do faxx[i] := fax[i-1]; for i := 1 to 10 do maill[i] := mail[i-1]; for i := 1 to 10 do bank[i] := banka[i-1]; end; rr := Insert(cf); // vlo₧enφ novΘho zßznamu do kurzoru if rr <> -1 then begin cf[rr].skupina := sk; // zapsßnφ ·daj∙ z prom∞nn²ch - beztypovΘ p°i°azenφ cf[rr].muz := true; cf[rr].firma := fir; cf[rr].firma2 := fir2; cf[rr].ulice := ulic; cf[rr].mesto := mest; cf[rr].psc := ps; cf[rr].stat := st; cf[rr].ico := ic; cf[rr].dic := dc; cf[rr].prep1 := p1; cf[rr].prep2 := p2; cf[rr].prep3 := p3; cf[rr].prep4 := p4; cf[rr].prep5 := p5; cf[rr].prep6 := p6; cf[rr].prep7 := p7; cf[rr].prep8 := p8; for i := 1 to 10 do if tel[i] <> "" then cf[rr].telefon[i-1] := tel[i]; for i := 1 to 10 do if faxx[i] <> "" then cf[rr].fax[i-1] := faxx[i]; for i := 1 to 10 do if maill[i] <> "" then cf[rr].mail[i-1] := maill[i]; for i := 1 to 10 do if bank[i] <> "" then cf[rr].banka[i-1] := bank[i]; Reset_view(id,-1,reset_cache+reset_controls); Set_ext_pos(id,rr,-1) ; // nastavenφ pohledu na nov² zßznam PosledniCislo; end else Info_box("Nelze","Nelze vlo₧it nov² zßznam"); end; Set_cursor(0); end; procedure Vlozeni; {**************************************} {vlo₧enφ novΘho zßznamu klßvesou Ins} var cx : cursor; rer : integer; begin if vsechnysk then Info_box('Nelze','Pro vlo₧enφ musφte mφt vybrßnu jednu konkrΘtnφ skupinu!') else begin Set_cursor(1); if id_sez>0 then Close_view(id_sez); if id = 0 then begin Open_view('*Pfirma',curmain,0,0,0,id); SetWindowText(id,s2); end else begin Pick_window(id); Send_message(id,1599,0,0); // odznaΦenφ p°φp. QBE dotazu end; Get_fcursor(id,cx,nil); rer := Insert(cx); // vlo₧it zßznam if rer <> -1 then begin cx[rer].skupina := skup; // zapsat skupinu Set_ext_pos(id,rer,-1); // pozice novΘho zßznamu PosledniCislo; // zapsat Φφslo zßznamu end; if id_sez>0 then // Reset_view(id_sez,-1,RESET_CACHE+RESET_CONTROLS); Set_cursor(0); end; end; procedure Smazani; {**************************************} {smazßnφ zßznamu klßvesou Ctrl+Del} var ic,ec : integer; ct,cx : cursor; sqldel : string[40]; cis : short; pocett : integer; spom : string[60]; begin if Active_view = id_sez then Prepnuti; // otev°enφ Pfirma na stejnΘm zßznamu if Get_fcursor(id,cx,nil) then if Get_view_pos(id,ic,ec) then begin cis := cx[ec].cislo; if cis = noneshort then Send_message(id,1603,0,0) else begin spom := 'SELECT * FROM Tschuzky WHERE cislo='+Int2str(cis); if not Open_sql_cursor(ct,spom) then begin if not Rec_cnt(ct,pocett) then begin if pocett = 0 then begin // nejsou kontakty Send_message(id,1603,0,0); // smazat end else begin if YesNo_box('Varovßnφ','Adresu nelze smazat, proto₧e v tabulce kontakt∙ existujφ odpovφdajφcφ zßpisy.'#10'Majφ se smazat zßpisy v tabulce kontakt∙ souΦasn∞?') then begin if not Delete_all_records(ct) then begin Send_message(id,1603,0,0); end else Info_box('Cbyba','Nezda°ilo se'); end; end; end else Signalize; Close_cursor(ct); end else Signalize; end; end; end; function VymazatZKontaktu(cis : integer) : boolean; {**************************************} var spom : string[60]; ct : cursor; begin VymazatZKontaktu := false; spom := 'SELECT * FROM Tschuzky WHERE cislo='+Int2str(cis); if not Open_sql_cursor(ct,spom) then begin if Delete_all_records(ct) then Signalize else VymazatZKontaktu := true; Close_cursor(ct); end else Signalize; end; procedure SmazatVsechnyZaznamy; {**************************************} var zam : boolean; sp : string[200]; cpom : cursor; spom : string[100]; i,pocetpom : integer; begin zam := false; // if myName <> 'DB_ADMIN' then Info_box('Nelze',' Smazat vÜechna data m∙₧e provΘst pouze sprßvce databßze!') // else begin if vsechnysk then sp := 'Opravdu chcete vymazat z Adresß°e vÜechny firmy'#10'vÜech skupin a zßznamy o kontaktech s nimi?' else sp := 'Opravdu chcete vymazat z Adresß°e vÜechny firmy'#10'skupiny > '+nazskup+' < a zßznamy o kontaktech s nimi?'; if YesNo_box('Varovßnφ',sp) then begin if id > 0 then Close_view(id); if id_sez > 0 then Close_view(id_sez); if Close_cursor(curmain) then Signalize; if not (Write_lock_table(Tfirma) or Write_lock_table(Tschuzky)) then begin if vsechnysk then spom := 'SELECT * FROM Tfirma' else spom := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup); if not Open_sql_cursor(cpom, spom) then begin Rec_cnt(cpom, pocetpom); if pocetpom > 0 then for i := 0 to pocetpom-1 do begin Set_status_nums(i,pocetpom-1); if VymazatZKontaktu(cpom[i].cislo) then if Delete(cpom,i) then Signalize; end; Close_cursor(cpom); end else Signalize; Free_deleted(Tfirma); Free_deleted(Tschuzky); Write_unlock_table(Tfirma); Write_unlock_table(Tschuzky); VyberSkupinu; if Open_sql_cursor(curmain,dotaz) then Signalize // v glob. prom. dotaz je ulo₧ena definice dotazu z proc VyberSkupinu else begin Open_view('*Pfirma',curmain,0,0,0,id); SetWindowText(id,s2); end; end else begin Info_box('Nelze zamknout','S tabulkami n∞kdo pracuje.'); zam := true; end; end; // end; end; procedure ZmenitSkupinuZaznamu; {**************************************} var id_zs : window_id; cx,cy : cursor; ic,ec : integer; res : integer; pocetzaz,i : integer; cis : short; u : untyped; begin if vsechnysk then Info_box('Nelze','Pro tuto operaci musφte mφt vybrßnu jednu konkrΘtnφ skupinu!') else begin zrusitAkci := true; jeden := 1; Open_view('*UrciSkup',no_redir,modal_view,0,0,id_zs); repeat Peek_message until id_zs = 0; SmazatFrontu; if not zrusitAkci then begin vsechnysk := false; nazskup := Skupiny[skup].nazev; s2 := 'Skupina: '+nazskup; s4 := 'P°ehled firem skupiny: '+nazskup; if Get_fcursor(Active_view,cx,nil) then begin if jeden = 1 then begin // zm∞na u jednoho zßznamu if Active_view = id_sez then Prepnuti; if (Get_view_item(id,54) = '') then PosledniCislo; Get_view_pos(id,ic,ec); cis := cx[ec].cislo; Start_transaction; cx[ec].skupina := skup; cx[ec].prep1 := false; cx[ec].prep2 := false; cx[ec].prep3 := false; cx[ec].prep4 := false; cx[ec].prep5 := false; cx[ec].prep6 := false; cx[ec].prep7 := false; cx[ec].prep8 := false; Commit; dotaz := 'SELECT * FROM Tfirma where skupina='+Int2str(skup); UplatnitDotaz; DoplnitTexty; u := cis; res := Look_up(curmain,'cislo',u); // zjiÜt∞nφ zßznamu s Φφslem cis if res <> -1 then Set_ext_pos(id,res,-1); SetWindowText(id,s2); Reset_view(id,-1,reset_cache+reset_controls); if id_sez>0 then SetWindowText(id_sez,s4); end else begin // zm∞na u vÜech sejmut²ch zßznam∙ Rec_cnt(cx,pocetzaz); if pocetzaz <> -1 then begin for i := 0 to pocetzaz-1 do begin Set_status_nums(i+1,pocetzaz); Start_transaction; cx[i].skupina := skup; cx[i].prep1 := false; cx[i].prep2 := false; cx[i].prep3 := false; cx[i].prep4 := false; cx[i].prep5 := false; cx[i].prep6 := false; cx[i].prep7 := false; cx[i].prep8 := false; Commit; end; dotaz := 'SELECT * FROM Tfirma where skupina='+Int2str(skup); UplatnitDotaz; DoplnitTexty; SetWindowText(id,s2); Reset_view(id,-1,reset_cache+reset_controls); if id_sez>0 then SetWindowText(id_sez,s4); end; end; end else Info_box('Chyba','Get_fcursor'); end; end; end; procedure Najit; {**************************************} {vyhledß zßznamy, kterΘ v sob∞ obsahujφ zadan² °et∞zec} var id_f,id_zal,id_vyb : window_id; wherestr : string[200]; costr : string[30]; sel : string[300]; pstr : string[30]; begin column := 1; zrusitAkci := true; Open_view('*Pfind',no_redir,modal_view,0,0,id_f); repeat Peek_message until id_f=0; SmazatFrontu; if not zrusitAkci then begin pstr := " .=."""+search+""""; case column of 1 : begin wherestr := 'firma'+pstr+' OR firma2'+pstr+' OR prijmeni'+pstr+' OR ulice'+pstr+' OR mesto'+pstr+' OR pozn'+pstr ; costr := ''; end; 3 : begin wherestr := 'firma'+pstr+' OR firma2'+pstr; costr := 'v nßzvu firmy '; end; 2 : begin wherestr := 'prijmeni'+pstr; costr := 've jmΘnu odp. pracovnφka '; end; 4 : begin wherestr := 'ulice'+pstr+' OR mesto'+pstr; costr := 'v adrese firmy '; end; 5 : begin wherestr := 'pozn'+pstr; costr := 'v poznßmce '; end; end; sel :='SELECT * FROM Tfirma WHERE '+wherestr; if Open_sql_cursor(cfind,sel) then Signalize; if Rec_cnt(cfind,pocetNalez) then Signalize; // pro podmφnku aktivity v pohledu Pvybrsuper s := 'V tabulce firem byly nalezeny tyto zßznamy obsahujφcφ '+costr+'°et∞zec '''+search+'''. TlaΦφtkem Firma si zobrazφte podrobn² popis vybranΘ firmy.'; Open_view('*pvybrsuper',no_redir,0,0,0,id_vyb); id_subvyb := GetDlgItem(id_vyb,3); if not Set_fcursor(id_subvyb,cfind,0) then Info_box('Chyba','Set_fcursor'); // vsechnysk := true; end; end; procedure ZavritKurzor; {**************************************} //akce po zav°enφ pohledu Pvybrsuper begin Close_cursor(cfind); end; procedure Prepni; {**************************************} {tlaΦφtko v pohledu Pvybrsuper s vybran²mi zßznamy - p°epne do formulß°e na stejn² zßznam} begin dotaz := 'SELECT * FROM Tfirma'; vsechnysk := true; s2 := 'VÜechny skupiny'; s4 := 'P°ehled firem vÜech skupin'; UplatnitDotaz; DoplnitTexty; if id=0 then begin Open_view('*pfirma',curmain,0,0,0,id); SetWindowText(id,s2); end; Synchronizace(id_subvyb,id); if id_sez > 0 then SetWindowText(id_sez,s4); end; function TestDotazu(odkud : short; dot : string[255]) : boolean; {************************************************} //odkud = 1 : nezobrazovat info o spravne syntaxi //odkud = 0 : zobrazovat var c_test : cursor; begin if Open_sql_cursor(c_test,dot) then begin Info_box('Test dotazu','Chyba v syntaxi'); TestDotazu := false end else begin if odkud=0 then Info_box('Test dotazu','Syntaxe v po°ßdku'); // tlacitko Test syntaxe Close_cursor(c_test); TestDotazu := true; end; end; procedure UlozitDotaz; {************************************************} var drec : trecnum; pop : string[20]; a : boolean; begin pop := ''; a := Input_Box('popis dotazu',pop,20); if a then begin drec := Insert(Tdotazy); Tdotazy[drec].cislo := drec; Tdotazy[drec].popis := pop; Tdotazy[drec].dotaz := dotaz; Tdotazy[drec].autord := Who_am_I; Info_box('Provedeno','OK'); end; end; procedure Ulozit(pom : short); {************************************************} begin SestavitDotaz; if TestDotazu(1,dotaz) then begin UlozitDotaz; ptatse := false; if pom = 1 then Close_view(id_tool); end; end; procedure ZavritTool; {************************************************} begin SestavitDotaz; if TestDotazu(1,dotaz) then begin if ptatse then if YesNo_box('Otßzka','Ulo₧it dotaz pro dalÜφ pou₧itφ?') then Ulozit(2); Close_view(id_tool); if id>0 then Send_message(id,1599,0,0); // odznaΦenφ p°φp. QBE dotazu if id_sez>0 then Send_message(id_sez,1599,0,0); UplatnitDotaz; end; end; procedure TestTlac; {************************************************} begin SestavitDotaz; TestDotazu(0,dotaz); end; procedure Vsechny; {**************************************} {vybrat vÜechny zßznamy} begin if id>0 then Send_message(id,1599,0,0); // odznaΦenφ p°φp. QBE dotazu if id_sez>0 then Send_message(id_sez,1599,0,0); if vsechnysk then dotaz := 'SELECT * FROM Tfirma' else dotaz := 'SELECT * FROM Tfirma WHERE skupina='+Int2str(skup); UplatnitDotaz; end; procedure VybratDotaz; {**************************************} {vybrat p°ipraven² dotaz a uplatnit ho} var id_dot : window_id; begin zrusitAkci := true; Open_view("*VyberDotaz",no_redir,modal_view,0,0,id_dot); repeat Peek_message until id_dot=0; SmazatFrontu; if not zrusitAkci then begin if id>0 then Send_message(id,1599,0,0); // odznaΦenφ p°φp. QBE dotazu if id_sez>0 then Send_message(id_sez,1599,0,0); dotaz := Tdotazy[dotazpom].dotaz; UplatnitDotaz; end; end; procedure EditDotaz; {**************************************} {opravit nebo smazat p°ipraven² dotaz} var id_edit : window_id; begin Open_view("*PDotazy",no_redir,0,0,0,id_edit); repeat Peek_message until id_edit=0; end; procedure ResetTool(ind : short) ; {************************************************} {vyΦistφ dotazov² tool a₧ k danΘmu °ßdku} var i : short; begin for i := 7 downto ind do begin atr[i] := 0; oper[i] := 0; hodn[i] := ''; spoj [i] := 0; end; if ind > 1 then spoj[ind-1] := 0; if id_tool > 0 then Reset_view(id_tool,-1,1); //p°ekreslenφ funguje pouze za b∞hu programu! end; procedure SmazatDotaz(idd : window_id; cis : integer); {************************************************} //tlaΦφtko Smazat u zßznamu v pohledu Pdotazy var cd : cursor; rescislo : integer; begin if YesNo_box('Otßzka','Opravdu chcete vymazat tento dotaz?') then begin if Get_fcursor(idd,cd,nil) then ; if Delete(cd,cis) then Signalize else Reset_view(idd,-1,RESET_DELETIONS+RESET_CURSOR); end; end; procedure NovyDotaz; {************************************************} begin Set_cursor(1); Set_status_text('Otevφrßm pohled pro sestrojenφ dotazu...'); ResetTool(1); ptatse := true; Open_view("*tool",no_redir,modal_view,0,0,id_tool); repeat Peek_message until id_tool=0; SmazatFrontu; end; procedure ToolProNovy; {************************************************} begin Set_cursor(1); Set_status_text('Otevφrßm pohled pro sestrojenφ dotazu...'); ResetTool(1); Open_view("*tool_n",no_redir,modal_view,0,0,id_tool); repeat Peek_message until id_tool=0; SmazatFrontu; end; procedure DveKat(idd : window_id); {**************************************} var i,s : short; begin for i := 1 to 8 do if p[i] then s := s+1; if s >= 2 then dvekateg := true else dvekateg := false; Reset_view(id,-1,1); end; procedure PodleKategorii; {**************************************} var id_pk : window_id; begin if vsechnysk then Info_box('Nelze','Pro v²b∞r podle kategoriφ musφte mφt vybrßnu jednu konkrΘtnφ skupinu!') else begin sp := 1; Open_view('*Podlekateg',-1,0,0,0,id_pk); repeat Peek_message until id_pk=0; if not zrusitAkci then begin SestavitDotazKateg; UplatnitDotaz; end; end; end; procedure Zobraz(tab : string[10]); {**************************************} var idx : window_id; sx : string[40]; begin sx := 'DEFAULT '+tab+' TABLEVIEW'; Open_view(sx,no_redir,0,0,0,idx); // repeat Peek_message until idx=0; end; function WTCesta(var cesta : string[100]) : boolean; {**************************************} {zjiÜt∞nφ cesty k programu WinText602 z registraΦnφ databßze Windows} var key : string[100]; s : string[100]; buf : integer; err : short; begin WTCesta := false; err := -1; buf := 100; key := 'WinText602\CurVer'; s := ''; RegQueryValue(1,key,s,buf); // zjiÜt∞nφ aktußlnφ verze WinTextu buf := 100; key := s+'\protocol\StdFileEditing\server'; s := ''; err := RegQueryValue(1,key,s,buf); // zjiÜt∞nφ cesty k Wintext602.exe cesta := s; // odkazem vrßcenß hodnota if err <> 0 then WTCesta := true; end; function WMCesta(var cesta : string[100]) : boolean; {**************************************} {zjiÜt∞nφ cesty k programu WinMana₧er602 z registraΦnφ databßze Windows} var key : string[100]; s : string[100]; buf : integer; err : short; begin WMCesta := false; err := -1; buf := 100; key := 'WinM602\Shell\Open\Command'; s := ''; err := RegQueryValue(1,key,s,buf); StrDelete(s,StrLength(s)-2,3); cesta := s; if err <> 0 then WMCesta := true; end; function WFCesta(var cesta : string[100]) : boolean; {**************************************} {zjiÜt∞nφ cesty k programu WinFax602 z registraΦnφ databßze Windows} var key : string[100]; s : string[100]; buf : integer; err : short; begin WFCesta := false; err := -1; buf := 100; key := 'WinFM602\Shell\Open\Command'; s := ''; err := RegQueryValue(1,key,s,buf); StrDelete(s,StrLength(s)-2,3); cesta := s; if err <> 0 then WFCesta := true; end; procedure LokalSablony; {**************************************} // pro OEM instalaci (lokßlnφ) je nutnΘ nastavit cestu k Üablonßm automaticky var spom : CSIstring[255]; begin spom := pathwt; UpCase(spom); StrDelete(spom,StrPos('\EXEC',spom),StrLength('\exec\wintext.exe')); spom := spom+'\SABLONY'; Parametry[0].sablonywt := spom; end; procedure LokalSablonyOEM; {**************************************} // 19.4. verze spec., LOF p°enese do C:\ADRESAR var spom : CSIstring[255]; begin spom := pathwb; Parametry[0].sablonywt := spom; end; function TestPrav : Boolean; {**************************************} {ov∞°enφ, mß-li p°ihlßÜen² u₧ivatel dostatek prßv pro prßci} var a,b,c,d,e,f,g,h,i,j : short; begin TestPrav := true; myname := Who_am_I; Get_data_rights(Tfirma, myName,a,b,c); Get_data_rights(MailMerge, myName,b,c,d); Get_data_rights(Tdotazy, myName,c,d,e); Get_data_rights(Tschuzky, myName,d,e,f); Get_data_rights(Parametry, myName,e,f,g); Get_data_rights(Tool_res, myName,f,g,h); Get_data_rights(TsablonyWT, myName,g,h,i); if (a and Right_read = 0) or (a and Right_write = 0) or (a and Right_insert = 0) or (a and Right_del = 0) or (b and Right_read = 0) or (b and Right_write = 0) or (b and Right_insert = 0) or (b and Right_del = 0) or (c and Right_read = 0) or (c and Right_write = 0) or (c and Right_insert = 0) or (c and Right_del = 0) or (d and Right_read = 0) or (d and Right_write = 0) or (d and Right_insert = 0) or (d and Right_del = 0) or (e and Right_read = 0) or (e and Right_write = 0) or (e and Right_insert = 0) or (e and Right_del = 0) or (f and Right_read = 0) or (f and Right_write = 0) or (f and Right_insert = 0) or (f and Right_del = 0) or (g and Right_read = 0) or (g and Right_write = 0) or (g and Right_insert = 0) or (g and Right_del = 0) then if YesNo_box("Upozorn∞nφ","Nemßte vÜechna pot°ebnß prßva,"#10"budou Vßm odep°eny n∞kterΘ akce."#10#10"PokraΦovat?") then begin if (e and Right_read = 0) or (e and Right_write = 0) or (e and Right_insert = 0) or (e and Right_del = 0) then begin Info_box('Nelze','Mßte tak mßlo prßv, ₧e nenφ mo₧no pokraΦovat.'); TestPrav := false; end; end else TestPrav := false; end; procedure Inicializace; {**************************************} var pocet : integer; begin konec := false; s2 := 'VÜechny Skupiny'; s4 := 'P°ehled firem vÜech skupin'; vsechnysk := true; vybrat := true; dvekateg := false; kolikrat := 1; kolikpred := 0; preview := 0; str_od := 1; str_do := 999; repsort := 1; nall := false; expkod := 3; exptype := 4; editTisk := false; kon := true; if Rec_cnt(Parametry,pocet) then {kdyby n∞kdo omylem smazal tabulku Parametry... } begin Signalize; Halt; end; if pocet = 0 then begin {kdyby n∞kdo omylem smazal zßznam v tab Parametry... } Insert(Parametry); end else begin {naΦtenφ velikosti naposled pou₧itΘho Ütφtku} labeltype := Parametry[0].typst; labelsize := Parametry[0].velik; template := Parametry[0].template; end; if Server_access(pathwb) then Info_box('Chyba','Chyba p°i zjiÜ¥ovßnφ cesty k databßzi WinBase.'#10'MailMerge nebude fungovat.'); if WTcesta(pathwt) then Info_box('Chyba','ZjiÜt∞nφ cesty k programu WinText602.'#10'MailMerge nebude fungovat.') ; if WMcesta(pathwm) then Info_box('Chyba','ZjiÜt∞nφ cesty k programu WinMana₧er602.'#10'VytßΦenφ Φφsel nebude fungovat.') ; if WFcesta(pathwf) then Info_box('Chyba','ZjiÜt∞nφ cesty k programu WinFM602.'#10'RychlΘ faxovßnφ nebude fungovat.'); // LokalSablony; // pro OEM verzi se Üablonami ve WT // LokalSablonyOEM; // pro OEM verzi bez nov²ch Üablon na matricφch WT Help_file("adresar3.hlp"); DoplnitTexty; if Open_sql_cursor(curmain,'SELECT * FROM Tfirma') then begin Signalize; Halt; end; Register_key(117,false,false,false,3000); {klßvesa F6 pro p°echod ze seznamu do formulß°e} Register_key(115,false,false,false,2222); {F4 Φφslo zßznamu} Register_key(114,false,false,false,2001); {klßvesa F3 pro otev°enφ formulß°e} Register_key(114,false,true,false,2002); {klßvesa Ctrl+F3 pro otev°enφ seznamu} Register_key(123,false,false,false,2050); {klßvesa F12 pro v²b∞r vÜech zßznam∙} Register_key(46,false,true,false,2083); {klßvesy Ctrl+Del pro smazßnφ zßznamu} Register_key(45,false,false,false,2080); {klßvesa Ins pro vlo₧enφ zßznamu} Register_key(45,false,true,false,2081); {klßvesy Ctrl+Ins pro vlo₧enφ kopie zßznamu} Register_key(119,true,false,false,9999); {zablokovßnφ klßvesy Shift+F8 (zruÜenφ zßznamu)} Register_key(118,true,false,false,9999); {zablokovßnφ klßvesy Shift+F7 (zruÜenφ vÜech zßznam∙)} end; {************************************************************} {****************** hlavnφ program ******************} {************************************************************} begin if 1 = 2 then begin if not TestPrav then halt; Inicializace; if not Main_menu ("*MHlavni") then halt; Open_view("*Pseznam",curmain,0,0,0,id_sez); SetWindowText(id_sez,s4); VyberSKupinu; while not konec and Get_ext_message (Msg, handle, NIL) do begin if msg = -1 then konec := true; {Konec} if msg = 2000 then VyberSkupinu; {Vybrat skupinu...} if msg = 2001 then {Adresß°} if id = 0 then begin Open_view("*Pfirma",curmain,0,0,0,id); SetWindowText(id,s2); Reset_view(id,-1,5); end else Close_view(id); if msg = 2002 then {P°ehled firem} if id_sez = 0 then begin Open_view("*Pseznam",curmain,0,0,0,id_sez); SetWindowText(id,s4); id_s := GetDlgItem(id_sez,3); Reset_view(id_sez,-1,5); end else Close_view(id_sez); if msg = 2003 then PrehledKontaktu; {P°ehled kontakt∙} if msg = 2004 then Export; if msg = 2005 then ImportDBF; if msg = 2006 then ImportTDT; if msg = 2100 then DefSkupin; {Nßzvy skupin} if msg = 2010 then Kategorie; {Text kategoriφ} if msg = 2011 then WT; {WinText} if msg = 2012 then Sablony; {èablony} if msg = 2013 then SdilenyAdresar; {Sdφlenφ Üablon} if msg = 2020 then TiskStitku(-1); {Tisk Ütφtk∙} if msg = 2021 then TiskSeznamu; {Tisk seznamu firem} if msg = 2025 then TiskMailMerge; {Mail Merge} if msg = 2032 then VyberStitku; {V²b∞r Ütφtku} if msg = 2033 then NastaveniTiskarny; {Nastavenφ tiskßrny} if msg = 2040 then Kontrola; {Kontrola databßze} if msg = 2041 then Zaloha; {Zßloha} if msg = 2042 then Obnoveni; {Obnovenφ} if msg = 2043 then Uvolneni; {Uvoln∞nφ} if msg = 2044 then OpravitIndexy; {Opravit indexy} if msg = 2045 then ResetCursor; {NaΦφst obsah} if msg = 2046 then NastavitZalohu; {Parametry zßlohy} if msg = 2047 then Prenosz2x; {P°enos dat z verze 2.x} if msg = 2049 then OdemknoutMM; {Odemknout} if msg = 2050 then Vsechny; {VÜechny zßznamy} if msg = 2051 then NovyDotaz; {Polo₧it dotaz} if msg = 2052 then VybratDotaz; {Vybrat dotaz} if msg = 2053 then ToolProNovy; {Definovat dotaz} if msg = 2054 then EditDotaz; {Opravit dotaz} if msg = 2055 then Najit; {Najit zßznam} if msg = 2061 then PodleKategorii; {Podle kategoriφ} if msg = 2080 then Vlozeni; {Nov² zßznam} if msg = 2081 then Kopie; {Kopie zaznamu} if msg = 2083 then Smazani; {ZruÜenφ zßznamu} if msg = 2084 then SmazatVsechnyZaznamy; {ZruÜit vÜe} if msg = 2105 then ZmenitSkupinuZaznamu; {} if msg = 2222 then PosledniCislo; {} if msg = 2301 then Zobraz('Tfirma'); if msg = 2302 then Zobraz('Tschuzky'); if msg = 2303 then Zobraz('Skupiny'); if msg = 2304 then Zobraz('Parametry'); if msg = 2305 then Zobraz('Tdotazy'); if msg = 2306 then Zobraz('Tinserty'); if msg = 3000 then Prepnuti; {p°epnutφ z p°ehledu firem do adresß°e (tlaΦφtko na liÜt∞)} if msg = 3001 then View_open("*Pinfo"); {Informace} if msg = 3002 then Show_help(20000); {Nßpov∞da k aplikaci} Set_status_text(""); end; Main_menu (nil); if Close_cursor(curmain) then Signalize; end; end.