API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 8th, 2011
39
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 12.86 KB | None | 0 0
raw download clone embed print report
  1.  
  2.  
  3. program morrediabo;
  4.  
  5. //cadastro de remedios/////////////////////////////
  6.  
  7.  
  8. {type tcadastro_de_remedio=record
  9. nome_do_remedio:string;
  10. preco:real;
  11. codigo_de_barra:integer;
  12. descricao:string;
  13. modo_de_uso:string;
  14. end;}
  15.  
  16. //cadastro de clientes/////////////////////////////
  17.  
  18. type tcadastro_de_clientes=record
  19. nome_do_cliente:string;
  20. tendereco:record
  21. telefone_fixo:integer;
  22. numero_celular:integer;
  23. numero_casa:integer;
  24. rua:string;
  25. bairro:string;
  26. cidade:string;
  27. estado:string;
  28. end;
  29. end;
  30.  
  31. //cadastro de funcionarios/////////////////////////
  32.  
  33. tcadastro_funcionario=record
  34. nome_funcionario:string;
  35. salario_fucionario:real;
  36. ttendereco:record
  37.  
  38. telefone_fixo:integer;
  39. numero_celular:integer;
  40. numero_casa:integer;
  41. rua:string;
  42. bairro:string;
  43. cidade:string;
  44. estado:string;
  45. end;
  46. end;
  47.  
  48. //estoque de remédios//////////////////////////////
  49.  
  50. testoque=record
  51. qtd_remedio:integer;
  52. nome_remedio:string;
  53. qtd:integer;
  54. cod:integer;
  55. end;
  56.  
  57. //caixa/////////////////////////////////////////////
  58.  
  59. tcaixa=record
  60. valor_pago:real;
  61. preco:real;
  62. preco1:real;
  63. nome:string;
  64. consultadepreco:string;
  65. produto_codigo:integer;
  66. valor_total:real;
  67. end;
  68.  
  69. //relatorio/////////////////////////////////////////
  70.  
  71. trelatorio=record
  72. remedio_mais_vendido:string;
  73. remedios_tarja_preta:string;
  74. apresentacao:string;
  75.  
  76. end;
  77.  
  78. //variaveis globais/////////////////////////////////
  79.  
  80. var cadastro_de_remedio:tcadastro_de_remedio;
  81. cadastro_de_clientes:tcadastro_de_clientes;
  82. cadastro_funcionario:tcadastro_funcionario;
  83. estoque:testoque;
  84. caixa:tcaixa;
  85. relatorio:trelatorio;
  86. endereco:ttendereco;
  87. opcaorepetir:char;
  88. i:integer;
  89. a:integer;
  90. arquivo_txt:array[1..20]of text;
  91.  
  92.  
  93. function aux_de_venda(var nome:string):integer;
  94. VAR S:STRING;
  95. numeroconv,ne,i :integer;
  96. t:text;
  97. begin
  98. assign(t,nome+'.txt');
  99. reset(t);
  100. while not eof(t) do
  101. begin
  102. readln(t,s);
  103. writeln(s);
  104. end;
  105. close(t);
  106. clrscr ;
  107. val ( s,numeroconv,ne );
  108. numeroconv:=numeroconv-1;
  109. writeln(numeroconv);
  110. end;
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117. //procedure exibe////////////////////////////
  118.  
  119. procedure exibe(var t:text);
  120. VAR S:STRING;
  121. begin
  122. reset(t);
  123. while not eof(t) do
  124. begin
  125. readln(t,s);
  126. writeln(s);
  127. end;
  128. close(t);
  129. end;
  130.  
  131.  
  132.  
  133. //funcao_cons_estoque/////////////////////////////////
  134.  
  135. procedure funcao_cons_estoque;
  136. //var arquivo_txt:text;
  137. var i,nome_cons,remedio:string;
  138. aux:integer;
  139. begin
  140. //writeln('Digite o nome do remédio:');
  141. //readln(remedio);
  142. Assign(arquivo_txt[1],'estoque.txt');
  143. Reset(arquivo_txt[1]);
  144. Close(arquivo_txt[1]);
  145. exibe(arquivo_txt[1]);
  146. readkey;
  147. readkey;
  148. end;
  149.  
  150.  
  151. //funcao caixa///////////////////////////////////////
  152.  
  153. procedure funcao_caixa;
  154. VAR opcao_caixa:char;
  155. begin
  156. repeat
  157.  
  158. writeln('Preço do produto:');
  159. readln(caixa.preco);
  160. caixa.preco1:=caixa.preco1+caixa.preco;
  161. clrscr ;
  162. writeln('Nome do produto:');
  163. readln(caixa.nome);
  164. clrscr ;
  165. writeln('Código do produto:');
  166. readln(caixa.produto_codigo);
  167. writeln('O valor a ser pago é: ',caixa.preco1);
  168. writeln('Deseja continuar? S/N');
  169. readln(opcao_caixa);
  170. UNTIL upcase(opcao_caixa)<>'S';
  171. writeln('Valor pago:');
  172. readln(caixa.valor_pago);
  173. clrscr ;
  174. caixa.valor_total:=caixa.valor_pago-caixa.preco1;
  175. writeln('Troco R$: ',caixa.valor_total);
  176. readkey;
  177. end;
  178.  
  179. //consulta de clientes///////////////////
  180. procedure funcao_consulta_cli;
  181. //var arquivo_txt:text;
  182.  
  183. var nome_cli_cons:string;
  184. begin
  185. writeln('Digite o nome do cliente:');
  186. readln(nome_cli_cons);
  187. Assign(arquivo_txt[2],nome_cli_cons+'.txt');
  188.  
  189. Reset(arquivo_txt[2]);
  190. Close(arquivo_txt[2]);
  191. exibe(arquivo_txt[2]);
  192. readkey;
  193. readkey;
  194. readkey;
  195. end;
  196.  
  197. //funcao cadastto de clientes////////////////////////
  198.  
  199. procedure funcao_cadastro_de_clientes;
  200. //var arquivo_txt:text;
  201. var nome_cli:string[30];
  202. opcao:char;
  203. NOME_COPY:STRING;
  204. begin
  205. opcao:='s';
  206. while ((opcao='s') or (opcao='S')) do
  207. begin
  208. writeln('Digite o nome do cliente:');
  209. readln(nome_cli);
  210. assign(arquivo_txt[3],nome_cli+'.txt');
  211. writeln('Digite o nome do cliente novamente:');
  212. rewrite(arquivo_txt[3]);
  213. append(arquivo_txt[3]);
  214. readln(cadastro_de_clientes.nome_do_cliente);
  215. NOME_COPY:=COPY(cadastro_de_clientes.nome_do_cliente,1,30);
  216. writeln(arquivo_txt[3],'NOME: ',cadastro_de_clientes.nome_do_cliente);
  217. writeln('Digite o endereço:');
  218. writeln('Rua:');
  219. readln(cadastro_de_clientes.tendereco.rua);
  220. writeln(arquivo_txt[3],'RUA: ',cadastro_de_clientes.tendereco.rua);
  221. writeln('Bairro:');
  222. readln(cadastro_de_clientes.tendereco.bairro);
  223. writeln(arquivo_txt[3],'BAIRRO: ',cadastro_de_clientes.tendereco.bairro);
  224. writeln('Cidade:');
  225. readln(cadastro_de_clientes.tendereco.cidade);
  226. writeln(arquivo_txt[3],'CIDADE: ',cadastro_de_clientes.tendereco.cidade);
  227. writeln('Digite o número da casa:');
  228. readln(cadastro_de_clientes.tendereco.numero_casa);
  229. writeln(arquivo_txt[3],'NUMERO: ',cadastro_de_clientes.tendereco.numero_casa);
  230. writeln('Estado:');
  231. readln(cadastro_de_clientes.tendereco.estado);
  232. writeln(arquivo_txt[3],'ESTADO: ',cadastro_de_clientes.tendereco.estado);
  233. writeln('Telefone fixo:');
  234.  
  235. readln(cadastro_de_clientes.tendereco.telefone_fixo);
  236. writeln(arquivo_txt[3],'FONE: ',cadastro_de_clientes.tendereco.telefone_fixo);
  237. close(arquivo_txt[3]);
  238. WRITELN(NOME_COPY,' CADASTRADO COM SUCESSO');
  239. writeln('Deseja Efetuar Outro Cadastro? S/N');
  240. readln(opcao);
  241. end;
  242. end;
  243.  
  244. //FUNCAO ESTOQUE/////////////////////////////////////
  245.  
  246. procedure funcao_estoque;
  247. //var arquivo_txt:text;
  248. var a:string;
  249. preco:real;
  250. opcao:char;
  251. begin
  252. opcao:='s';
  253. while ((opcao='s') or (opcao='S')) do
  254. begin
  255. //writeln('Digite o nome do remédio: ');
  256. //readln(estoque.nome_remedio);
  257. assign(arquivo_txt[4],'estoque.txt');
  258. //rewrite(arquivo_txt);
  259. append(arquivo_txt[4]);
  260. writeln('Digite a quantidade de remédios');
  261. readln(estoque.qtd_remedio);
  262. writeln('Digite o nome do remédio');
  263. readln(estoque.nome_remedio);
  264. writeln(arquivo_txt[4],' ');
  265. write(arquivo_txt[4],estoque.nome_remedio,' ');
  266. write(arquivo_txt[4],estoque.qtd_remedio,' Unidade(s) R$: ');
  267. writeln('Digite o preço da unidade:');
  268. readln(preco);
  269. write(arquivo_txt[4],preco:2:2,' ');
  270. close(arquivo_txt[4]);
  271. writeln('Deseja adicionar um novo remedio ao estoque? S/N');
  272. readln(opcao);
  273. end;
  274. end;
  275.  
  276. //funcao cadastro de funcionarios///////////////////
  277.  
  278. procedure funcao_cadastro_de_funcionario;
  279. //var arquivo_txt:text;
  280. var nome_arquivo:string;
  281. opcao:char;
  282. NOME_COPY:string;
  283. begin
  284. opcao:='s';
  285. while ( (opcao = 's' ) or (opcao = 'S') ) do
  286. begin
  287. writeln('Digite o nome do funcionario:');
  288. readln(nome_arquivo);
  289. assign(arquivo_txt[5],nome_arquivo+'.txt');
  290. rewrite(arquivo_txt[5]);
  291. NOME_COPY:=COPY(nome_arquivo,1,30);
  292. writeln('Digite o nome do funcionário:');
  293. readln(cadastro_funcionario.nome_funcionario);
  294. writeln(arquivo_txt[5],'NOME: ',cadastro_funcionario.nome_funcionario);
  295. writeln('digite o endereco');
  296. writeln('Rua');
  297. readln(cadastro_funcionario.ttendereco.rua);
  298. writeln(arquivo_txt[5],'RUA: ',cadastro_funcionario.ttendereco.rua);
  299. writeln('Bairro');
  300. readln(cadastro_funcionario.ttendereco.bairro);
  301. writeln(arquivo_txt[5],'BAIRRO: ',cadastro_funcionario.ttendereco.bairro);
  302. writeln('Cidade');
  303. readln(cadastro_funcionario.ttendereco.cidade);
  304. writeln(arquivo_txt[5],'CIDADE: ',cadastro_funcionario.ttendereco.cidade);
  305. writeln('Digite o numero da casa');
  306. readln(cadastro_funcionario.ttendereco.numero_casa);
  307. writeln(arquivo_txt[5],'NUMERO: ',cadastro_funcionario.ttendereco.numero_casa);
  308. writeln('Estado');
  309. readln(cadastro_funcionario.ttendereco.estado);
  310. writeln(arquivo_txt[5],'ESTADO: ',cadastro_funcionario.ttendereco.estado);
  311. writeln('Salário');
  312. readln(cadastro_funcionario.salario_fucionario);
  313. writeln(arquivo_txt[5],'SALARIO: ',cadastro_funcionario.salario_fucionario:2:2);
  314. writeln('Telefone fixo:');
  315. readln(cadastro_funcionario.ttendereco.telefone_fixo);
  316. writeln(arquivo_txt[5],'FONE: ',cadastro_funcionario.ttendereco.telefone_fixo*1);
  317. close(arquivo_txt[5]);
  318. writeln(NOME_COPY,' CADASTRADO COM SUCESSO');
  319. writeln('Deseja fazer outro cadastro? S/N');
  320. readln(opcao);
  321. end;
  322. end;
  323.  
  324. //procedure para menu/////////////////////////////
  325.  
  326. procedure menuinicial;
  327. begin
  328. writeln('Entre com o tipo de usuário');
  329. writeln('1. Gerente:');
  330. writeln('2. Caixa:');
  331. writeln('3. Proprietário/Dono:');
  332. end;
  333.  
  334. //funcao menu de opcao//////////////////////////////
  335.  
  336. procedure menu_gerente;
  337. var opcao_menu_gerente:integer;
  338. begin
  339. writeln('1. Novo estoque:');
  340. writeln('2. Para cadastro de funcionários:');
  341. writeln('3. Consulta de estoque:');
  342. writeln('4. Consulta de clientes/funcionários:');
  343. readln(opcao_menu_gerente);
  344.  
  345. case opcao_menu_gerente of
  346. 1:funcao_estoque;
  347. 2:funcao_cadastro_de_funcionario;
  348. 3:funcao_cons_estoque;
  349. 4:funcao_consulta_cli;
  350. end;
  351.  
  352. end;
  353.  
  354. //menu dono///////////////////////////////////////
  355.  
  356. procedure menu_dono;
  357. var opcao_dono:integer;
  358. begin
  359. writeln('1. Para cadastro de cliente:');
  360. writeln('2. Venda de produto:');
  361. writeln('3. Consutar estoque:');
  362. writeln('4. Novo estoque:');
  363. writeln('5. Para cadastrar funcionários:');
  364. readln(opcao_dono);
  365.  
  366. case opcao_dono of
  367. 1:funcao_cadastro_de_clientes;
  368. 2:funcao_caixa;
  369. 3:funcao_cons_estoque;
  370. 4:funcao_estoque;
  371. 5:funcao_cadastro_de_funcionario;
  372.  
  373.  
  374.  
  375. end;
  376. end;
  377.  
  378.  
  379. //funcao menu de opcao//////////////////////////////
  380.  
  381. procedure menu_caixa;
  382. var opcao_menu_caixa:integer;
  383. begin
  384. writeln('1. Para cadastro de cliente:');
  385. writeln('2. Venda de produto:');
  386. writeln('3. Consulta de estoque ou preço:');
  387. readln(opcao_menu_caixa);
  388. case opcao_menu_caixa of
  389.  
  390. 1:funcao_cadastro_de_clientes;
  391. 2:funcao_caixa;
  392. 3:funcao_cons_estoque
  393. else
  394. writeln('Erro de escolha, voltará para o menu inicial...');
  395. readkey;
  396. end;
  397.  
  398. end;
  399.  
  400.  
  401. //procedure para cadastro de remedios//////////////
  402.  
  403. procedure cadastro_remedio_menu;
  404. var opcao:integer;
  405. begin
  406.  
  407. readln(opcao);
  408. clrscr ;
  409. case opcao of
  410. 1:menu_gerente;
  411. 2:menu_caixa;
  412. 3:menu_dono;
  413. end;
  414.  
  415. end;
  416.  
  417.  
  418. //programa principal///////////////////////////////
  419.  
  420. Begin
  421.  
  422. TEXTCOLOR(yellow);
  423. a:=1;
  424. while a>=1 do
  425. begin
  426. a:=a+1;
  427. if keypressed then a:=-1;
  428. if ((a>1) and (a<1000)) then textcolor(blue);
  429. if ((a>=1000) and (a<2000)) then textcolor(green);
  430. if ((a>=2000) and (a<3000)) then textcolor(yellow);
  431. if ((a>=3000) and (a<4000)) then textcolor(red);
  432. if ((a>=4000) and (a<5000)) then textcolor(white);
  433. if a>5000 then a:=1;
  434. gotoxy(1,1);
  435. writeln('Site: WWW.INFORMACIA.COM.BR');
  436. gotoxy(1,3);
  437. writeln(' 00 0000 00 000000 000000 00000 0000 0000 0000000 000000 00 0000000');
  438. gotoxy(1,4);
  439. writeln(' 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00');
  440. gotoxy(1,5);
  441. writeln(' 00 00 00 00 000000 00 00 00000 00 00 00 00 0000000 00 00 0000000');
  442. gotoxy(1,6);
  443. writeln(' 00 00 0000 00 00 00 00 00 00 0000 00 00 00 00 00 00 00 00');
  444. gotoxy(1,7);
  445. writeln(' 00 00 00 00 000000 00 00 00 00 00 00 00 000000 00 00 00');
  446.  
  447.  
  448.  
  449.  
  450. gotoxy(10,10);
  451. writeln('BEM VINDO AO SOFTWARE COMERCIAL "INFORMACIA"');
  452. gotoxy(10,11);
  453. WRITELN('mais um software das empresas Zé Paulo');
  454. gotoxy(10,12);
  455. writeln('Pressione ENTER para iniciar a interface do programa');
  456. end;
  457. clrscr ;
  458.  
  459. for i:=1 to 50 do
  460. begin
  461. gotoxy(10,10);
  462. writeln('Carregando arquivos... ',i*2,'%');
  463. gotoxy(i,11);
  464. TEXTCOLOR(yellow);writeln(#176);
  465. delay(200);
  466. end;
  467.  
  468.  
  469. repeat
  470. TEXTCOLOR(yellow);
  471. textbackground ( blue ) ;
  472. clrscr ;
  473. menuinicial;
  474. cadastro_remedio_menu;
  475. clrscr ;
  476. writeln('Deseja voltar para o menu inicial? [S/N]');
  477. readln(opcaorepetir);
  478. until(upcase(opcaorepetir))<> 'S';
  479.  
  480. End.
  481.  
  482.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!