|
|
Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.
Mensajes - moyo18
Páginas: [1]
1
« en: Jueves 7 de Junio de 2007, 19:58 »
ya intente como dice F_Tanori mira la nueva parte del nuevo codigo me queda asi $buscar=trim($buscar); if (trim($buscar)!="" ) { echo "No has introducido los datos necesarios para la busqueda."; exit; }
viendo la otra pagina q dejaste probe asi y no funciono , ptambien probe usando nada mas esat linea , ya ni tira el mensaje No has introducido los datos necesarios para la busqueda $buscar=trim($buscar);
y no funciiono no muestra los resultados siempre me sale q ponga los datos y ya lo estoy poniendo, pero en mi server local me funciona bien :S. tambien cuando pongo el codigo d arriba buscar=trim($buscar); if (trim($buscar)!="" )
me sale un error Warning: mysql_num_rows(): supplied argument is not a valid MySQL result resource in /home/nuevajer/public_html/registro/buscar.php on line 38 borro esa parte del codigo q nada mas es como un contador para ver los miembros q saldrian encontrados por la busqueda, pero al darle buscar me sale nada mas Miembros encontrados y no muestra nada. por el de avalon me sirvio de maravilla el codigo, muchas gacias  . no necesite modificar nada.
2
« en: Jueves 7 de Junio de 2007, 05:56 »
bueno la cosa esta asi, en un hostlocal q tengo en mi pc con appserv, las busquedas me sirven perfecto, pero al pasar a un sevidor me tira q no he introducido los datos y si los pongo. estos son los codigos del form y el php <html> <head> <title> Busqueda de Miembros del Grupo</title> </head> <body> <h1> Resultados busqueda</h1> <?php // confirmacion de entrada de datos trim($buscar); if (!$opcion || !$buscar) { echo "No has introducido los datos necesarios para la busqueda."; exit; } $opcion = addslashes ($opcion); $buscar = addslashes ($buscar); // conexion base d datos cambiar los datos de la base de datos por los tuyos @ $db = mysql_pconnect ("localhost","miuser","mipass"); if (!$db) { echo "No ha conectado con la base datos"; exit; } // llamar a la base de datos usar cambiar por el nombre de su base de datos mysql_select_db ("nombredb"); // consulta $consulta = "select * from registro where ".$opcion." like '%".$buscar."%'"; $resultado = mysql_query($consulta); $num_resultado=mysql_num_rows($resultado); echo "<p>Miembros encontrados: ".$num_resultado."</p>"; for ($i=0; $i<$num_resultado; $i++) { $row = mysql_fetch_array ($resultado); echo "<p><strong>".($i+1).".Nombre: "; echo stripslashes($row["nombre"]); echo "</strong><br>Apellido:"; echo stripslashes ($row["apellido"]); echo "</p>"; } ?> </body> </html>
aki esta el form <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" /> <title>Documento sin título</title> </head> <body> <h1>Busqueda de Miempbros</h1> <form action="buscar.php" method="post"> Elige tipo de busqueda<br> <select name="opcion"> <option value="nombre">Nombre <option value="apellido">Apellido </select> <br> Escribe el termino de busqueda: <BR> <input name="buscar" type=text> <br> <input type=submit value="buscar"> </form> </body> </html>
pngo los datos y al darle enviar me sale esto No has introducido los datos necesarios para la busqueda porq me sale eso ? si tengo el dato introducido para la busqueda, pero en mi localhost me sirve bien con el appserv pero en el servidor q estoy pagando no.
3
« en: Lunes 26 de Febrero de 2007, 22:50 »
buneo he estado busca y busca y he encontrado algunos codigos, he hehco paso a paso lo q iban diciendo y si he logrado hacerlo pero cuando ya quiero ver la foto, ejecutar el programa para ver si se peude me sale un error en el codigo y por mas vuelta q le doy no veo dond esta el fallo ya q muchos codigos son iguales aki les dejo el codigo q llevo unit database; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, DB, ADODB, Grids, DBGrids; type TForm1 = class(TForm) DBGrid1: TDBGrid; ADOTable1: TADOTable; DataSource1: TDataSource; ADOConnection1: TADOConnection; ADOimage: TImage; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses jpeg; {$R *.dfm} function JpegStartsInBlob (PicField:TBlobField):integer; var bS : TADOBlobStream; buffer : Word; hx : string; begin Result := -1; bS := TADOBlobStream.Create(PicField, bmRead); try while (Result = -1) and (bS.Position + 1 < bS.Size) do begin bS.ReadBuffer(buffer, 1); hx:=IntToHex(buffer, 2); if hx = 'FF' then begin bS.ReadBuffer(buffer, 1); hx:=IntToHex(buffer, 2); if hx = 'D8' then Result := bS.Position - 2 else if hx = 'FF' then bS.Position := bS.Position-1; end; //if end; //while finally bS.Free end; //try end; procedure TForm1.Button1Click(Sender: TObject); var bS : TADOBlobStream; Pic : TJpegImage; begin bS := TADOBlobStream.Create (AdoTable1Picture, bmRead); try bS.Seek(JpegStartsInBlob(AdoTable1Picture), soFromBeginning); Pic:=TJpegImage.Create; try Pic.LoadFromStream(bS); ADOImage.Picture.Graphic:=Pic; finally Pic.Free; end; finally bS.Free end; end;
y aki me da el error, es en el boton bS := TADOBlobStream.Create (AdoTable1Picture, bmRead);
a dond dice Adotable1picture, bmread a ver si me pueden decir el error ahi ya t se supone q esta bien todo porq lo saque d aki delphi.about.com/od/database/l/aa030601d.htm porq me da un error??
4
« en: Sábado 24 de Febrero de 2007, 05:12 »
hola ya solucione ese problema d arriba, bueno ahora el problema es q no se como hacer para q se conbinen los colores en un RGB, TENGO Q HACERLO usando SCROLLBARS pero no se como se haria hasta el momento llevo esto y estoy tratando ver ver . unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, CheckLst; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Panel1: TPanel; Panel2: TPanel; CheckBox1: TCheckBox; CheckBox2: TCheckBox; RadioGroup1: TRadioGroup; ComboBox1: TComboBox; GroupBox1: TGroupBox; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; Panel6: TPanel; Panel7: TPanel; Panel8: TPanel; Edit1: TEdit; Label1: TLabel; Label2: TLabel; Button3: TButton; RadioGroup2: TRadioGroup; Button4: TButton; ScrollBar1: TScrollBar; ScrollBar2: TScrollBar; ScrollBar3: TScrollBar; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; CheckListBox1: TCheckListBox; procedure Button2Click(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure CheckListBox1Click(Sender: TObject); procedure Panel3Click(Sender: TObject); procedure Panel4Click(Sender: TObject); procedure Panel5Click(Sender: TObject); procedure Panel6Click(Sender: TObject); procedure Panel7Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure ScrollBar2Change(Sender: TObject); procedure ScrollBar3Change(Sender: TObject); private { Private declarations } public end; var Form1: TForm1; acolor : Tcolor; lol : String; implementation {$R *.dfm} procedure TForm1.Button2Click(Sender: TObject); begin panel1.color := clwhite; panel2.color := clwhite; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case radiogroup1.Itemindex of 0 : acolor := Tcolor($0000A5FF); 1 : acolor := clYellow; 2 : acolor := clgreen; 3 : acolor := clblue; 4 : acolor := clred; end; end; procedure TForm1.Button1Click(Sender: TObject); begin if checkbox1.Checked then panel1.Color := acolor; if checkbox2.Checked then panel2.color := acolor; end; procedure TForm1.ComboBox1Change(Sender: TObject); begin case combobox1.itemindex of 0 : acolor := Tcolor($0000A5FF); 1 : acolor := clYellow; 2 : acolor := clblue; 3 : acolor := clgreen; 4 : acolor := clred; end; end; procedure TForm1.CheckListBox1Click(Sender: TObject); begin case Checklistbox1.ItemIndex of 0 : acolor := Tcolor($0000A5FF); 1 : acolor := clyellow; 2 : acolor := clgreen; 3 : acolor := clblue; 4 : acolor := clred; end; end; procedure TForm1.Panel3Click(Sender: TObject); begin acolor := Tcolor($0000A5FF); end; procedure TForm1.Panel4Click(Sender: TObject); begin acolor := clyellow; end; procedure TForm1.Panel5Click(Sender: TObject); begin acolor := clgreen; end; procedure TForm1.Panel6Click(Sender: TObject); begin acolor := clblue; end; procedure TForm1.Panel7Click(Sender: TObject); begin acolor := clred; end; procedure TForm1.FormCreate(Sender: TObject); begin panel3.color := Tcolor($0000A5FF); panel4.color := clyellow; panel5.color := clgreen; panel6.color := clblue; panel7.color := clred; radiogroup2.Itemindex := 0; end; procedure TForm1.Edit1Change(Sender: TObject); begin LowerCase(edit1.text); if (edit1.text = 'orange') or (edit1.text = 'ORANGE') then acolor := Tcolor($0000A5FF); if (edit1.text = 'yellow') or (edit1.text = 'YELLOW') then acolor := clyellow; if (edit1.text = 'green') or (edit1.text = 'GREEN') then acolor := clgreen; if (edit1.text = 'blue') or (edit1.text = 'BLUE') then acolor := clblue; if (edit1.text = 'red') or (edit1.text = 'RED') then acolor := clred; end; procedure TForm1.Button3Click(Sender: TObject); begin case radiogroup2.ItemIndex of 0 : begin edit1.Visible := true; label3.Visible := true; label4.Visible := true; label5.Visible := true; label6.Visible := true; label7.Visible := true; end; 1 : Combobox1.Visible := true; 2 : checklistbox1.Visible := true; 3 : groupbox1.Visible := true; 4 : radiogroup1.Visible := true end; radiogroup2.visible := false; checkbox1.visible := true; checkbox2.visible := true; button1.visible := true; button2.visible := true; button4.visible := true; button3.Visible := false; end; procedure TForm1.Button4Click(Sender: TObject); begin radiogroup2.Visible := true; button4.visible := false; button3.Visible := true; edit1.Visible := false; label3.Visible := false; label4.Visible := false; label5.Visible := false; label6.Visible := false; label7.Visible := false; Combobox1.Visible := false; checklistbox1.Visible := false; groupbox1.Visible := false; radiogroup1.Visible := false; checkbox1.visible := false; checkbox2.visible := false; button1.visible := false; button2.visible := false; panel1.color := clwhite; panel2.color := clwhite; end; procedure TForm1.ScrollBar1Change(Sender: TObject); begin lol := '$0000FF'+' $FF0000'+'RGB(0,255,0)' ; panel1.color := $0000FF end; procedure TForm1.ScrollBar2Change(Sender: TObject); begin panel1.color := $FF0000; end; procedure TForm1.ScrollBar3Change(Sender: TObject); begin panel1.color := RGB(0,255,0); end; end.
no se como hacer para mezclar los colores.
5
« en: Viernes 23 de Febrero de 2007, 20:27 »
casi igual al formulario q puse abajo bueno ahora tengo otro problema, al elegir los colores desd un combobox, checklistbox, y otros mas q he agregado, no salen, al darle click al boton aplicar se ponen los paneles negros. este es el codigo q llevo, intente cambiandovaliables a ver si asi salia pero nop, el unico q sirve es el d edit q al escribir red asigna el color rojo pero lo asigna y lo guarda ya no lo cambia no se porq aki el codigo q llevo unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CheckLst, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; Panel2: TPanel; Panel1: TPanel; CheckBox1: TCheckBox; CheckBox2: TCheckBox; RadioGroup2: TRadioGroup; Edit1: TEdit; GroupBox1: TGroupBox; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; Panel6: TPanel; Panel7: TPanel; Panel8: TPanel; CheckListBox1: TCheckListBox; ComboBox1: TComboBox; RadioGroup1: TRadioGroup; Button3: TButton; Button4: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure Panel3Click(Sender: TObject); procedure Panel4Click(Sender: TObject); procedure Panel5Click(Sender: TObject); procedure Panel6Click(Sender: TObject); procedure Panel7Click(Sender: TObject); procedure Panel8Click(Sender: TObject); procedure CheckListBox1Click(Sender: TObject); procedure ComboBox1Change(Sender: TObject); procedure RadioGroup2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Edit1Change(Sender: TObject); private { Private declarations } public pcolor : Tcolor; hola : Tcolor; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin if checkbox1.checked then panel1.color := pcolor; if checkbox2.checked then panel2.color := pcolor; end; procedure TForm1.Button2Click(Sender: TObject); begin panel1.Color := clwhite; panel2.Color := clwhite; end; procedure TForm1.FormCreate(Sender: TObject); begin panel1.Color := clwhite; panel2.Color := clwhite; GroupBox1.Visible := false; edit1.Visible:= false; radiogroup1.Visible := false; combobox1.Visible := false; checklistbox1.Visible := false; radiogroup2.Visible := true; button4.Visible := false; end; procedure TForm1.RadioGroup1Click(Sender: TObject); begin case RadioGroup1.ItemIndex of 0 : hola := Tcolor($0000A5FF); 1 : hola := clyellow; 2 : hola := clgreen; 3 : hola := clblue; 4 : hola := clred; end; end; procedure TForm1.Panel3Click(Sender: TObject); begin pcolor := clyellow end; procedure TForm1.Panel4Click(Sender: TObject); begin pcolor := clblue; end; procedure TForm1.Panel5Click(Sender: TObject); begin pcolor := clgreen; end; procedure TForm1.Panel6Click(Sender: TObject); begin pcolor := Tcolor($0000A5FF); end; procedure TForm1.Panel7Click(Sender: TObject); begin pcolor := clred; end; procedure TForm1.Panel8Click(Sender: TObject); begin pcolor := clsilver; end; procedure TForm1.CheckListBox1Click(Sender: TObject); begin case checklistbox1.ItemIndex of 0 : pcolor := Tcolor($0000A5FF); 1 : pcolor:= clyellow; 2 : pcolor := clgreen; 3 : pcolor := clblue; 4 : pcolor := clred; end; end; procedure TForm1.ComboBox1Change(Sender: TObject); begin case combobox1.ItemIndex of 0 : pcolor := Tcolor($0000A5FF); 1 : pcolor := clyellow; 2 : pcolor := clgreen; 3 : pcolor := clblue; 4 : pcolor := clred; end; end; procedure TForm1.RadioGroup2Click(Sender: TObject); begin case RadioGroup2.ItemIndex of 0 : radiogroup1.Visible := true; 1 : groupbox1.Visible := true; 2 : edit1.Visible := true; 3 : checklistbox1.Visible := true; 4 : combobox1.Visible := true; end; end; procedure TForm1.Button3Click(Sender: TObject); begin case RadioGroup2.ItemIndex of 0 : radiogroup1.Visible := true; 1 : groupbox1.Visible := true; 2 : edit1.Visible:= true; 3 : checklistbox1.Visible := true; 4 : combobox1.Visible := true; end; radiogroup2.Visible := false; button3.Visible := false; button4.Visible := true; end; procedure TForm1.Button4Click(Sender: TObject); begin button3.Visible := true; button4.Visible := false; GroupBox1.Visible := false; edit1.Visible:= false; radiogroup1.Visible := false; combobox1.Visible := false; checklistbox1.Visible := false; radiogroup2.Visible := true; end; procedure TForm1.Edit1Change(Sender: TObject); begin LowerCase(edit1.text); if(edit1.text='red') then pcolor := clred; end; end.
aki les dejo un enlace para bajar el exe q llevo por ahorita para q vean el erro q digo bajar
6
« en: Viernes 23 de Febrero de 2007, 00:21 »
hola ya estuvo amigo muchas gracias, ya se ahora como hacerle, t agradesco por la ayuda.
el problema es q el CLORANGE no lo reconoce porq quizas no hay un color naranja o algo espcifico asi, bueno no se hasta ahroita buscare en google a ver q encuentro gracias.
7
« en: Viernes 23 de Febrero de 2007, 00:04 »
hola intente hacerlo como lo dices pero me da un error aki begin Case RadioGroup1.ItemIndex of 0 : RadioGroup1.color := ClOrange; 1 : RadioGroup1.Color := clYellow; 2 : RadioGroup1.Color := clBlue; 3 : RadioGroup1.Color := clGreen; end; usando el varcolor o el radiogropu1. no se porq me da el error :  , tambine tengo q hacer si los dos checkbox estan chekados q se ponga el color q esta elegido en los paneles. pwero bueno porq me dara ese error, si yo miro q esta bien el codigo.
8
« en: Jueves 22 de Febrero de 2007, 05:00 »
bueno se q esta raro esto pero pues es la primera vez q trabajo en delphi y aun no me hubico bien. la cosa es esta tengo dos cajas una en la cual al presionar un boton una se pondra del color q yo elija d un radiogroup y tambien tengo q chekiar con un checkbox en cual ira si en la 1 o la 2 y hacer un boton para poner blancas las dos cajas o paneles. la cuestion es q se como poner los colores y lo d las checkobs pero no se como poner el codigo para el boton d aplicar el color me confundo en esa parte. aki les dejo ell codigo q llevo unit assignment; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm2 = class(TForm) Label1: TLabel; Label2: TLabel; Panel1: TPanel; Panel2: TPanel; Button1: TButton; Button2: TButton; CheckBox1: TCheckBox; CheckBox2: TCheckBox; RadioGroup1: TRadioGroup; procedure Button1Click(Sender: TObject); procedure RadioGroup1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure CheckBox2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.dfm} procedure TForm2.Button1Click(Sender: TObject); begin panel1.color := clwhite; panel2.color := clwhite; end; procedure TForm2.RadioGroup1Click(Sender: TObject); begin Case RadioGroup1.ItemIndex of 0 : RadioGroup1.Color := clorange; 1 : RadioGroup1.Color := clYellow; 2 : RadioGroup1.Color := clblue; 3 : RadioGroup1.Color := cl green; end; end; procedure TForm2.Button2Click(Sender: TObject); begin Case RadioGroup1.ItemIndex of 0 : RadioGroup1.Color := clorange; 1 : RadioGroup1.Color := clYellow; 2 : RadioGroup1.Color := clblue; 3 : RadioGroup1.Color := cl green; end; if checkbox1.Checked then panel1.color := RadioGroup1.ItemIndex; if checkbox2.Checked then panel2.color := RadioGroup1.ItemIndex; end; procedure TForm2.CheckBox1Click(Sender: TObject); begin if checkbox1.Checked then TForm2.Button2Click(Sender: TObject); end; procedure TForm2.CheckBox2Click(Sender: TObject); begin if checkbox2.Checked then TForm2.Button2Click(Sender: TObject); end; end.
por cierto no me deja el delphi probar a ver como va, alguien sabe porq sera?? me sale el RUN deshabilitado.
9
« en: Martes 21 de Noviembre de 2006, 22:20 »
bueno tengo q hacer un calendario, hasta el momento ya tengo el primer dia del a;o q es el q necesito ya el a;o bisiesto. el problema esta asi en el a;o 1752 septiembre solo tiene 19 dias empieza 1,2,14,15 en adelante entonces no se como imprimir en pntalla los dias d el a;o, bueno rodos los dias d todos los a;o, nose como podria ahcerlo. el programaa tiene q salir q pida el a;o q quiere saber y q muestre los meses d ese a;o, tiene q salir d 4 meses en 4 enero julio febrero agosto marzo sept abril oct mayo nom junio dic en ese orden pero q se muetren 4 y al bajar salgan los otros 4 y asi. ya tengo todo hecho solo ese es mi problema como mostrar los dias en pantalla empezando desd el 1 d enero haste el 31 d dic. ya tengo q dia caeria el prmer dia del a;o solo esta q meta los dias en el calendario pero no se como. aki les dejo el codigo q llevo, tengo problemas con el array para imprimir en pantalla, casi no puedo usarlos. PROGRAM calendar; { MoYo } USES CRT; CONST MaxRows = 108; BlankCell = ' '; TYPE RowRange = 1..MaxRows; WeekDaysType = (sunday, monday, tuesday, wednesday, thursday, friday, saturday ); MonthsYearType = (january, february, march, april, may, june, july, august, september, october, november, december); CellType = string[4]; YearRange = 1400..2600; CalendarArrayType = array [1..MaxRows,WeekDaysType] of CellType; VAR YearChosen : YearRange; CalendarArray : CalendarArrayType; CurrentDay : weekdaystype; Rows, Columns : BYTE; Z, A, B, C, M : INTEGER; {******************************************************} PROCEDURE Initialize (VAR CalendarArray : CalendarArrayType; MaxRows : RowRange; BlankCell : CellType); VAR Rows : RowRange; Columns : WeekDaysType; CurrentRow : RowRange; CurrentColumn : WeekDaysType; CurrentMonth : MonthsYearType; BEGIN { Initialize } CLRSCR; FOR Rows := 1 to MaxRows do BEGIN FOR Columns := sunday to saturday do BEGIN CalendarArray [ Rows, Columns ] := BlankCell; END; END; { Name of the months } CurrentRow := 1; CalendarArray [ CurrentRow, Sunday ] := 'Janu'; CalendarArray [ CurrentRow, Monday ] := 'ary '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Febr'; CalendarArray [ CurrentRow, Monday ] := 'uary'; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Marc'; CalendarArray [ CurrentRow, Monday ] := 'h '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Apri'; CalendarArray [ CurrentRow, Monday ] := 'l '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'May '; CalendarArray [ CurrentRow, Monday ] := ' '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'June'; CalendarArray [ CurrentRow, Monday ] := ' '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'July'; CalendarArray [ CurrentRow, Monday ] := ' '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Augu'; CalendarArray [ CurrentRow, Monday ] := 'st '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Sept'; CalendarArray [ CurrentRow, Monday ] := 'embe'; CalendarArray [ CurrentRow, Tuesday ] := 'r '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Octo'; CalendarArray [ CurrentRow, Monday ] := 'ber '; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Nove'; CalendarArray [ CurrentRow, Monday ] := 'mber'; INC (CurrentRow, 9); CalendarArray [ CurrentRow, Sunday ] := 'Dece'; CalendarArray [ CurrentRow, Monday ] := 'mber'; { End of the name of the months } { Name of the days } CurrentRow := 2; FOR CurrentMonth := January TO December Do BEGIN CalendarArray [ CurrentRow, Sunday ] := 'Sun '; CalendarArray [ CurrentRow, Monday ] := 'Mon '; CalendarArray [ CurrentRow, Tuesday ] := 'Tue '; CalendarArray [ CurrentRow, Wednesday ] := 'Wed '; CalendarArray [ CurrentRow, Thursday ] := 'Thu '; CalendarArray [ CurrentRow, Friday ] := 'Fri '; CalendarArray [ CurrentRow, Saturday ] := 'Sat '; INC (CurrentRow, 9); END; END; { Initialize } { Test Code FOR Rows := 1 to maxrows DO BEGIN FOR Columns := Sunday TO Saturday DO WRITE (CalendarArray [ Rows, Columns ]:4); WRITELN; END; READKEY; } {************************************************************} {************************************************************} PROCEDURE GetTheYear (VAR YearChosen : YearRange ); BEGIN { GetTheYear } REPEAT WRITE ('INTRODUCE THE YEAR (1400..2600):'); READLN(YearChosen); UNTIL (YearChosen >= 1400) AND (YearChosen <= 2600) END; { GetTheYear } {***********************************************************} {***********************************************************} Procedure FillCalendarArray ( VAR CalendarArray : CalendarArrayType; YearChosen : YearRange; MaxRows : RowRange); { LEAP YEAR } FUNCTION IsLeapYear (YearChosen : YearRange) : BOOLEAN; BEGIN IsLeapYear := ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) END; { END LEAP YEAR } PROCEDURE FirstDay (yearChosen : YearRange; VAR Z : Integer); BEGIN { Zeller's Congruence } { IGNORE THIS PART, THIS PART IS TO KNOW THE OTHERS DAYS OF THE YEAR IF ( M<=2 ) THEN A:= 1+10; B:= (YearChosen-1) MOD 100; C:= (YearChosen-1) DIV 100; } IF ( M>=3) THEN BEGIN A:= 1-2; B:= YearChosen MOD 100; C:= YearChosen DIV 100; END; IF YearChosen = 1400 THEN Z := 5; {*****************************************************************} IF (YearChosen >= 1401) AND (YearChosen <= 1500) THEN BEGIN Z := (702 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7; IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN Z := Z-1 ELSE Z:= Z-1; END; {******************************************************************} IF (YearChosen >= 1501) AND (YearChosen <= 1700) THEN BEGIN Z := (703 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7; IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN Z := Z-1 ELSE Z := Z-1; END; {*********************************************************} IF (YearChosen >= 1701) AND (YearChosen <= 1751) THEN BEGIN Z := (704 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7; IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN Z := Z-1 ELSE Z := Z-1; END; {********************************************************} IF YearChosen = 1748 THEN Z:= 6; {********************************************************} IF YearChosen = 1752 THEN Z:= 4; {*************************************************************} IF (YearChosen >= 1753) AND (YearChosen <= 2600) THEN BEGIN Z:= (700 + ((26*A) -2) DIV 10 + 1 + B + (B DIV 4) + (C DIV 4) - (2 * C )) MOD 7; IF ((YearChosen MOD 4) = 0) AND ((Yearchosen MOD 100) <> 0) OR ((Yearchosen MOD 400) = 0) THEN Z:= Z - 1; END; END; { Zeller's Congruence } {***************************************************************************} { days of the months } FUNCTION Days (VAR Months : Monthsyeartype; YearChosen : YearRange ) : INTEGER; BEGIN CASE Months OF january : Days := 31; february : BEGIN IF ((YearChosen MOD 4) = 0) AND ((YearChosen MOD 100) <> 0) OR ((YearChosen MOD 400) = 0) THEN Days := 29 ELSE Days := 28; END; march : Days := 31; april : Days := 30; may : Days := 31; june : Days := 30; july : Days := 31; august : Days := 31; september : BEGIN IF YearChosen = 1752 THEN Days := 19 ELSE Days := 30; END; october : Days := 31; november : Days := 30; december : Days :=31; END; END; { end days of the months } {begin the fuction } FUNCTION CurrentDay ( Z : INTEGER ) : WeekDaysType; BEGIN CASE Z OF 0 : CurrentDay := saturday; 1 : CurrentDay := sunday; 2 : CurrentDay := monday; 3 : CurrentDay := tuesday; 4 : CurrentDay := wednesday; 5 : CurrentDay := thursday; 6 : CurrentDay := friday; END; { end of the function } BEGIN { FillCalendarArray } FirstDay (YearChosen, Z); END; { END FillCalendarArray } { GET THE FIRST DAY OF THE YEAR IF (year < 2000) THEN FOR Firstday := (2000 - 1) DOWNTO year DO ELSE FOR Firstday := 2000 TO (year - 1) DO BEGIN END; END OF THE FIRST DAY OF THE YEAR } {*****************************************************} {*****************************************************} { aki es dond tengo q ver lo d los numeros pero no se como hacer para q salgan en pantalla con los meses y los dias d la semana} PROCEDURE DisplayCalendar (VAR CalendarArray : CalendarArrayType ); VAR Daysofyear : INTEGER; BEGIN FOR Daysofyear := 1 TO 31 DO END; {*****************************************************} {*****************************************************} BEGIN { MAIN PROGRAM } Initialize ( CalendarArray, MaxRows, BlankCell); GetTheYear ( YearChosen ); FillCalendarArray ( CalendarArray,YearChosen, MaxRows ); { esta parte me falta DisplayMonths ( CalendarArray ); } END. { MAIN PROGRAM }
a ver si me pueden ayudar a ver como seria un kodigo d for para imprimir en la pantalla, despues yo lo temino
Páginas: [1]
|
|
|
Mostrar Mensajes
