Pascal/Turbo Pascal - String solo 256?

 
Vista:
sin imagen de perfil

String solo 256?

Publicado por Willy (177 intervenciones) el 02/01/2008 05:06:59
Como están?.. usuarios del foro!

Tengo el problema de que solamente se puede ingresar 256 caracteres para almacenar en una variable de tipo String.

Estoy haciendo un programa y quiero que el usuario pueda ingresar una nota grande que quede almacenada en un archivo junto con otros datos.

Lo que necesito es saber si existe alguna variable que pueda almacenar mayor cantidad de texto o si hay alguna manera de aumentar la capacidad de almacenamiento de una String.

Les agradezco mucho su atención!
Saludos!
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:String solo 256?

Publicado por preludio (17 intervenciones) el 03/01/2008 01:29:09
lo maximo es 256.

lo q podes hacer , es crear un 'archivo de texto' para la nota q ingresa el usuario(aqui no tenes limites para el texto.).
y para los demas datos las variables de siempre (integer, string, real, record, etc..).

ojala te sirva =D

bye ++
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

RE:String solo 256?

Publicado por Willy (177 intervenciones) el 07/01/2008 01:19:40
Gracias preludio!

Creo que esa es la manera correcta.
Es un programa que almacenará muchas notas y creo que voy a tener que crear muchos archivos de texto.

Cópien y peguen el código en un archivo para abrirlo con Turbo Pascal.

Me gustaría mucho que le hecharan un vistazo. Aun está en construcción.
Los comentarios y críticas, son bienvenidos.
No espero que examinen mucho el código fuente, pues es largo y además el indentado (que es vital para la comprensión del programa) no lo respeta este editor de texto del foro pero si quieren pueden criticar los colores, menus y todo lo demás.
Saludos!


(*******************************************)
(* Dise¤ado para el seguimiento de equipos *)
(* del departamento t‚cnico de Retail. *)
(* *)
(* Turbo Pascal 7. *)
(* Dise¤ador y programador Willy De Le¢n *)
(* Guatemala 01/01/2008 *)
(*******************************************)

Program Control_Taller;
Uses Crt, Dos, Graph, Graficas, Mouse;

const
Dias : array [0..6] of String[9] =
('Domingo','Lunes','Martes','Mi‚rcoles','Jueves','Viernes','S bado');

Type
TipoEquipos = record {para almacenarar todos los datos de cada equipo}
Marca, Modelo, NumSerie, Empresa, Depto, Encargado, Tecnico,
NotaReport, NumReport, Falla, TrabajoRealizado, Garantia,
EstatusReparacion, FechaSalida, FechaCompra, FechaVenta,
NumFacturaCompra, NumFacturaVenta, Proveedor : String;
{Se necesita almacenar la fecha como n£mero para ordenar por fecha}
AnioIngreso, MesIngreso, DiaIngreso, DiaSemanaIngreso : Word;
End;
{ GetDate(Anio, Mes, Dia, DiaSemana);
Writeln('Hoy es ', Dias[DiaSemana],', ', Mes:0, '/', Dia:0, '/', Anio:0);}
Var
MenuSeleccionado, EstoyMenuPrincipal,
SalirPrograma, EstoyIngresarEquipo : Boolean;
Equipo : TipoEquipos;
Archivo : File of TipoEquipos;
{Crea un menu seleccionable}
Procedure MenuSeleccionable(X1,Y1,X2,Y2: Integer; Texto: String;
Tamanio: Integer);
Begin {MouseInRect - Unit mouse.pas}
If Tamanio = 1 then SetTextStyle(DefaultFont,HorizDir,1);
If Tamanio = 2 then SetTextStyle(DefaultFont,HorizDir,2);
While MouseInRect(X1-25,Y1-18,X2-25,Y2-18) do{si el puntero se encuentra}
Begin {dentro de estas coordenadas}
If MenuSeleccionado = false then
Begin {Si el puntero se encuentra sobre el menu}
SetColor(11);
OutTextXY(X1,Y1,Texto);
SetColor(3);
OutTextXY(X1-1,Y1+1,Texto);
MenuSeleccionado := true;{No es que el t¡tulo est‚ seleccionado sino}
End;{If} {que el puntero se encuentra sobre el.}
If LMouseDown then
Begin {IngresarEquipo seleccionado}
SetColor(15); Rectangle(X1-6,Y1-3,X2-33,Y2-23);
Delay(175);{para que el rect ngulo se muestre por 175 Milisegundos}
If (X1 = 50) and (Y1 = 120) and (X2 = 323) and (Y2 = 162) then
begin
EstoyIngresarEquipo := True;
EstoyMenuPrincipal := False;
SetMousePos(620,460);{Cambia la posici¢n del puntero}
End;
{Si el puntero se encuentra sobre el t¡tulo "Volver".}
If (X1 = 50) and (Y1 = 75) and (X2 = 142) and (Y2 = 110) then
begin
EstoyIngresarEquipo := False;
EstoyMenuPrincipal := True;
SetMousePos(620,460);
End;
{"Salir"}
If (X1 = 50) and (Y1 = 430) and (X2 = 122) and (Y2 = 465) then
begin
EstoyMenuPrincipal := False;
SalirPrograma := True;
SetMousePos(620,460);
End;

End;{If}
End;{While}

If MenuSeleccionado = True then
Begin
SetColor(9);
OutTextXY(X1,Y1,Texto);
SetColor(1);
OutTextXY(X1-1,Y1+1,Texto);
MenuSeleccionado := false;
end;{If Menu}
End;{Procedure MenuSeleccionable}

{Crea los campos para que el usuario ingrese datos en un registro.}
Procedure Campo(X,Y: Integer; Var Variable: String);
Var InicioRegistro : integer; {Contiene la coordenada X del cursor}
Cadena1, Cadena2,Cadena3,Cadena4 : string; {almacenar nota de 1024}
TeclaPres : Char;{Teca Presionada} { caracteres}

Begin {12 p¡xeles de caracter a caracter}
InicioRegistro := X+(Length(Variable)*12); TeclaPres := '0'; Cadena1 := ''; Cadena2 := '';
Cadena3 := '';Cadena4 := '';{Inicializando variables como nulas}
If MouseInRect(X-3, Y-3, X+189, Y+10) and LMouseDown then
Begin
SetColor(7); SetMousePos(X+218,Y);{coloca el puntero fuera del campo}
Repeat
If not KeyPressed then
Begin{Hace intermitente el cursor}
SetFillStyle(1,8); bar(InicioRegistro-1,Y,InicioRegistro+12,Y+8);
Delay(100); OutTextXY(InicioRegistro,Y,'_'); delay(100);
OutTextXY(InicioRegistro,Y,'_');
End;
If Keypressed then
Begin
TeclaPres := (ReadKey);{TeclaPres tendr el valor de tecala presionada}
Case Ord(TeclaPres) of
65..90, 48..57, 97..122, 32, 130, 160..163 :{Caracteres permitidos}
Begin
If InicioRegistro < X+185 then{Se dispondr de 185 p¡xeles longitud}
Begin { para escribir en el campo.}
SetColor(7);
SetColor(8); OutTextXY(InicioRegistro,Y,'_');SetColor(7);
OutTextXY(InicioRegistro,Y,TeclaPres);
InicioRegistro := InicioRegistro + 12;{InicioR. = posici¢n cursor}
Variable := Variable + TeclaPres;{A Variable se le ir sumando el}
End; { valor de TeclaPres.}
End;
End;{Case}
If TeclaPres = char(8) then {Si se preciona BackSpace entonces..}
Begin{12 p¡xeles entre cada caracter. Borra caracter.}
InicioRegistro := InicioRegistro - 12;
If InicioRegistro < X+1 then InicioRegistro := X+1;
SetFillStyle(1,8);
bar(InicioRegistro-1,Y,InicioRegistro+24,Y+8);{borra caracteres}
delete(Variable,Length(Variable),1);{borra caracteres(a la variable)}
End;{if Tec}
End;{if KeyPressed}
Until TeclaPres = char(13); {Enter}
SetFillStyle(1,8);
bar(InicioRegistro-1,Y,InicioRegistro+12,Y+8);{Borra cursor}
end;
End;{Procedure Campo}

{Crea pantalla para ingresar dados de equipos}
Procedure IngresarEquipo;
Begin
EstoyIngresarEquipo := true;
SetFillStyle(SolidFill,0);
Bar(30,65,600,440);{Borra rea de pantalla}
SetMousePos(319,80);

SetTextStyle(DefaultFont,HorizDir,2);
SetColor(11);
OutTextXY(190,75,'Ingresar equipo');
SetColor(3);
OutTextXY(189,76,'Ingresar equipo');

SetTextStyle(DefaultFont,HorizDir,1);
SetColor(9);
OutTextXY(50,75,'Volver');
SetColor(1);
OutTextXY(49,76,'Volver');

SetColor(9);
OutTextXY(530,75,'Guardar');
SetColor(1);
OutTextXY(529,76,'Guardar');

SetFillStyle(SolidFill,8); Bar(25,100,610,455); SetMousePos(319,200);

SetTextStyle(DefaultFont,HorizDir,1);
Rectangle(73, 133, 281, 145);{Dibuja marco para ingresar dato de "Marca"}
Rectangle(273, 233, 481, 245);{"Modelo"}
Repeat
MenuSeleccionable(50,75,142,110,'Volver',1);
MenuSeleccionable(530,75,622,110,'Guardar',1);

Campo(75,135,Equipo.Marca);{Almacena dato ingresado en la variable}
Campo(275,235,Equipo.Modelo);

Until EstoyIngresarEquipo = False;
End;{Procedure IngresarEquipo}

Procedure MenuPrincipal;
Begin
LimitMouse(0,0,639,479);
EstoyMenuPrincipal := True;
MenuSeleccionado := False;

SetFillStyle(SolidFill,0);
Bar(22,65,618,458);
SetMousePos(319,150);

SetTextStyle(DefaultFont,HorizDir,2);
SetColor(9);
OutTextXY(50,120,'Ingresar equipo');
SetColor(1);
OutTextXY(49,121,'Ingresar equipo');

SetColor(9);
OutTextXY(50,200,'Ver equipos existentes');
SetColor(1);
OutTextXY(49,201,'Ver equipos existentes');

SetTextStyle(DefaultFont,HorizDir,1);
SetColor(9);
OutTextXY(50,430,'Salir');
SetColor(1);
OutTextXY(49,431,'Salir');

Repeat
MenuSeleccionable(50,120,323,162,'Ingresar equipo',2);
MenuSeleccionable(50,200,442,242,'Ver equipos existentes',2);
MenuSeleccionable(50,430,122,465,'Salir',1);{El 1 indica tama¤o}

Until EstoyMenuPrincipal = False;
End;

Begin {Principal}
EstoyIngresarEquipo := False; EstoyMenuPrincipal := True;
SalirPrograma := False;
IniciaGraficas; {graficas.pas}
SetMouseCursor(0); ShowMouse; {mouse.pas}

SetMousePos(315,125); {mouse.pas}
RandomGround(5,5,632,7,0,2); {tubo de arriba}
RandomGround(5,8,632,10,8,10);
RandomGround(5,11,632,12,2,10);
{RandomGround graficas.pas}
RandomGround(5,467,633,469,2,10); {tubo de abajo}
RandomGround(5,470,633,472,8,10);
RandomGround(5,473,633,474,0,2);

RandomGround(5,8,7,470,0,2);{tubo izquierdo}
RandomGround(8,8,10,470,8,10);
RandomGround(11,8,12,470,2,10);

RandomGround(626,8,628,471,2,10);
RandomGround(629,8,631,471,8,10);{RandomGround dibuja un rect ngulo }
RandomGround(632,8,633,471,0,2); {relleno con 2 colores espec¡ficos }
{de p¡xeles posicionados al azar. }
SetTextStyle(DefaultFont,HorizDir,3);
SetColor(10);
OutTextXY(55,29,'Seguimiento de equipos');
SetColor(2);
OutTextXY(54,30,'Seguimiento de equipos');

SetColor(2);
Rectangle(35,20,600,63);

Repeat
If EstoyMenuPrincipal = True then MenuPrincipal;
If EstoyIngresarEquipo = True then IngresarEquipo;

Until SalirPrograma = True;

{ GetDate(Anio, Mes, Dia, DiaSemana);
Writeln('Today is ', Dias[DiaSemana],', ', Mes:0, '/', Dia:0, '/', Anio:0);
}

CloseGraph
End.{256 l¡neas. Fin del programa 04/01/2008. A£n en construcci¢n.}
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

RE:String solo 256?

Publicado por Willy (177 intervenciones) el 07/01/2008 01:33:21
Disculpen!
Por poquito se me olvidava.
Auquí estan las units.

Oh! ho..

No pude enviar esa unit porque es muy grande
Por supuesto esta no la hice yo jaja. Pero está excelente!

Esta página me dió el siguiente error:

Error: El tamaño máximo para un mensaje es de 10000 caracteres

Voy a intentar mandarla en dos notas..
****************************************************************************

Unit Mouse;
{ Steven Sanderson }

INTERFACE

Uses Crt, graph;

Const ARROW = 0;
CROSSHAIR = 1;
MAGNIFY = 2;
BUSY = 3;
STRETCH = 4;
SMILEY = 5;
HAND = 6;
PEN = 7;

Function LMouseDown : Boolean;
Function RMouseDown : Boolean;
Function CheckDblLClick(maxtime : Integer) : Boolean;
Function CheckDblRClick(maxtime : Integer) : Boolean;
Procedure WaitLMouseClick(maxtime : Integer);
Procedure WaitRMouseClick(maxtime : Integer);
Procedure WaitMouseClick;
Procedure WaitDoubleClick;
Function CheckDoubleClick : Boolean;

Procedure ShowMouse;
Procedure HideMouse;
Procedure LimitMouse(x1, y1, x2, y2 : Integer);
Procedure SetMouseCursor(img : Integer);
Function GetMouseX : Integer;
Function GetMouseY : Integer;
Function MouseInRect(x1, y1, x2, y2 : Integer) : Boolean;
Procedure SetMousePos(x, y : Integer);

IMPLEMENTATION

Function LMouseDown : Boolean; Assembler;
Asm
MOV ax, 3 { Get Mouse State function }
INT 33h { Call MS Mouse driver }
MOV ax, bx { Button state in return register }
AND ax, 1 { Clear all but left button state }
End;

Function CheckDblLClick(maxtime : Integer) : Boolean; Assembler;
Asm
{ Store original time }
SUB sp, 2 { Allocate one word for time variable }
MOV ax, 0 { Get clock ticks function }
INT 1Ah { Call clock interrupt }
MOV [bp-2], dx { Result in time variable }

{ Wait for mouse up }
@loop1:
CALL @CheckTimeOut { Check for timeout }
CALL LMouseDown { Determine state of left button }
CMP ax, 1 { Is it down? }
JE @loop1 { Loop if it is }

{ Wait for mouse down }
@loop2:
CALL @CheckTimeOut { Check for timeout }
CALL LMouseDown { Determine state of left button }
CMP ax, 0 { Is it up? }
JE @loop2 { Loop if it is }

{ Wait for mouse up }
@loop3:
CALL @CheckTimeOut { Check for timeout }
CALL LMouseDown { Determine state of left button }
CMP ax, 1 { Is it down? }
JE @loop3 { Loop if it is }

{ Return TRUE }
ADD sp, 2 { Deallocate mem for time variable }
MOV ax, 1 { Return value = TRUE }
JMP @end { Exit function }

@CheckTimeOut:
MOV ax, 0 { Get ticks subfunction }
INT 1Ah { Call clock interrupt }
MOV ax, dx { Put new time in ax }
MOV dx, [bp-2] { Put time variable in dx }
SUB ax, dx { Difference in ax }
MOV bx, 50 { 1 tick = 50ms }
MUL bx { Convert to milliseconds }
CMP ax, maxtime { Compare with stated maximum }
JG @timeout { Jump if timed out }
RETN { Go back if not timed out }

@timeout:
MOV ax, 0 { Return FALSE }
ADD sp, 4 { Restore stack: 2 for time variable, 2 for this call}

@end: { Exit function }
End;

Function RMouseDown : Boolean; Assembler;
Asm
MOV ax, 3 { Get Mouse State function }
INT 33h { Call MS Mouse driver }
MOV ax, bx { Button state in return register }
SHR ax, 1 { Put right-button bit in least significant bit }
AND ax, 1 { Clear all but right button state }
End;

Function CheckDblRClick(maxtime : Integer) : Boolean; Assembler;
Asm
{ Store original time }
SUB sp, 2 { Allocate one word for time variable }
MOV ax, 0 { Get clock ticks function }
INT 1Ah { Call clock interrupt }
MOV [bp-2], dx { Result in time variable }

{ Wait for mouse up }
@loop1:
CALL @CheckTimeOut { Check for timeout }
CALL RMouseDown { Determine state of right button }
CMP ax, 1 { Is it down? }
JE @loop1 { Loop if it is }

{ Wait for mouse down }
@loop2:
CALL @CheckTimeOut { Check for timeout }
CALL RMouseDown { Determine state of right button }
CMP ax, 0 { Is it up? }
JE @loop2 { Loop if it is }

{ Wait for mouse up }
@loop3:
CALL @CheckTimeOut { Check for timeout }
CALL RMouseDown { Determine state of right button }
CMP ax, 1 { Is it down? }
JE @loop3 { Loop if it is }

{ Return TRUE }
ADD sp, 2 { Deallocate mem for time variable }
MOV ax, 1 { Return value = TRUE }
JMP @end { Exit function }

@CheckTimeOut:
MOV ax, 0 { Get ticks subfunction }
INT 1Ah { Call clock interrupt }
MOV ax, dx { Put new time in ax }
MOV dx, [bp-2] { Put time variable in dx }
SUB ax, dx { Difference in ax }
MOV bx, 50 { 1 tick = 50ms }
MUL bx { Convert to milliseconds }
CMP ax, maxtime { Compare with stated maximum }
JG @timeout { Jump if timed out }
RETN { Go back if not timed out }

@timeout:
MOV ax, 0 { Return FALSE }
ADD sp, 4 { Restore stack: 2 for time variable, 2 for this call}

@end: { Exit function }
End;
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

RE:String solo 256?

Publicado por Willy (177 intervenciones) el 07/01/2008 01:36:19
Procedure ShowMouse; Assembler;
Asm
MOV ax, 1 { Show mouse function }
INT 33h { MS Mouse interrupt call }
End;

Procedure HideMouse; Assembler;
Asm
MOV ax, 2 { Hide mouse function }
INT 33h { MS Mouse interrupt call }
End;

Procedure LimitMouse(x1, y1, x2, y2 : Integer); Assembler;
Asm
CALL GetgraphMode { Determine screen mode }
CMP ax, $FFFF { Is it text mode ? }
JE @textmode { Go there if it is }

MOV cx, x1 { Min X }
MOV dx, x2 { Max X }
MOV ax, 7h { Limit X function }
INT 33h { MS Mouse Interrupt call }

MOV cx, y1 { Min Y }
MOV dx, y2 { Max Y }
MOV ax, 8h { Limit Y function }
INT 33h { MS Mouse Interrupt call }

JMP @end { Exit now }

@textmode:
SUB sp, 6 { Allocate 6 bytes (3 words) }

MOV ax, x1 { Min X }
CALL @convert { Convert to pels }
MOV [BP-6], ax { Store new value }

MOV ax, y1 { Min Y }
CALL @convert { Convert to pels }
MOV [BP-4], ax { Store new value }

MOV ax, x2 { Min X }
CALL @convert { Convert to pels }
MOV [BP-2], ax { Store new value }

MOV ax, y2 { Min Y }
CALL @convert { Convert to pels }

MOV cx, [BP-4] { Min X }
MOV dx, ax { Max Y }
MOV ax, 08h { Limit Y function }
INT 33h { MS Mouse Interrupt call }

MOV cx, [BP-6] { Min X }
MOV dx, [BP-2] { Max X }
MOV ax, 07h { Limit X function }
INT 33h { MS Mouse Interrupt call }

ADD sp, 4 { Deallocate memory }
JMP @end { Exit procedure }

@convert:
SUB ax, 1 { Make zero-based }
SHL ax, 3 { Multiply by 8 }
RETN { Go back }

@end:
End;

Procedure SetMouseCursor(img : Integer); Assembler;
Asm
{ Get pointer to selected data }
MOV ax, img { AX = the image number passed }
MOV bx, 68 { Each cursor structure occupies 68 bytes }
MUL bx { Multiply by 64 to get offset }
LEA dx, @BitmapBase { Location of base address in dx }
ADD dx, ax { Add on offset calculated above }

{ Set up registers and call INT 33h }
MOV ax, 09h { Set Graphics Cursor subfunction }
MOV bx, dx { Pointer to data structure in BX }
PUSH cs { Code Segment on stack... }
POP es { ...and into Extra Segment }
PUSH ds { Store DS for later restoration }
PUSH cs { Code Segment on stack... }
POP ds { ...and into Data Segment }
MOV cx, [bx+2] { Vertical offset of hotspot }
MOV bx, [bx] { Horizontal offset of hotspot }
POP ds { Restore DS }
ADD dx, 4 { Get past hotspot data }
INT 33h { Call the MS Mouse driver }

{ Finished }
JMP @end { Exit now }

@BitmapBase:
{ -------------- ARROW CURSOR ------------- }
{ Hotspot }
DW 0, 0
{ Screen Mask }
DW 0011111111111111B
DW 0001111111111111B
DW 0000111111111111B
DW 0000011111111111B
DW 0000001111111111B
DW 0000000111111111B
DW 0000000011111111B
DW 0000000001111111B
DW 0000000000111111B
DW 0000000000011111B
DW 0000000111111111B
DW 0001000011111111B
DW 0011000011111111B
DW 1111100001111111B
DW 1111100001111111B
DW 1111110001111111B

{ Cursor Mask }
DW 0000000000000000B
DW 0100000000000000B
DW 0110000000000000B
DW 0111000000000000B
DW 0111100000000000B
DW 0111110000000000B
DW 0111111000000000B
DW 0111111100000000B
DW 0111111110000000B
DW 0111110000000000B
DW 0110110000000000B
DW 0100011000000000B
DW 0000011000000000B
DW 0000001100000000B
DW 0000001100000000B
DW 0000000000000000B

{ -------------- CROSSHAIR CURSOR ------------- }
{ Hotspot }
DW 7, 7
{ Screen Mask }
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B
DW 1111111111111111B

{ Cursor Mask }
DW 0000000000000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0111111011111100B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000000000000B
DW 0000000000000000B

{ -------------- MAGNIFY CURSOR ------------- }
{ Hotspot }
DW 6, 6
{ Screen Mask }
DW 1111100011111111B
DW 1110000000111111B
DW 1100000000011111B
DW 1000000000001111B
DW 1000000110001111B
DW 0000001111000111B
DW 0000011111000111B
DW 0000111111000111B
DW 0000111110000111B
DW 1000011100000111B
DW 1100000000000111B
DW 1110000000000011B
DW 1111100011000001B
DW 1111111111100000B
DW 1111111111110000B
DW 1111111111111000B

{ Cursor Mask }
DW 0000000000000000B
DW 0000011100000000B
DW 0001100011000000B
DW 0010001000100000B
DW 0010110000100000B
DW 0100100000010000B
DW 0101000000010000B
DW 0100000000010000B
DW 0010000000110000B
DW 0010000000110000B
DW 0001100011110000B
DW 0000011100111000B
DW 0000000000011100B
DW 0000000000001110B
DW 0000000000000110B
DW 0000000000000000B
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

RE:String solo 256?

Publicado por Willy (177 intervenciones) el 07/01/2008 01:38:12
{ -------------- BUSY CURSOR ------------- }
{ Hotspot }
DW 6, 6

{ Screen Mask }
DW 1000000000000011B
DW 1000000000000011B
DW 1000000000000011B
DW 1100011111000111B
DW 1100010001000111B
DW 1110001010001111B
DW 1111000100011111B
DW 1111100000111111B
DW 1111100000111111B
DW 1111000100011111B
DW 1110001010001111B
DW 1100010001000111B
DW 1100010001000111B
DW 1000000000000011B
DW 1000000000000011B
DW 1000000000000011B

{ Cursor Mask }
DW 0000000000000000B
DW 0011111111111000B
DW 0000000000000000B
DW 0001000000010000B
DW 0001001110010000B
DW 0000100100100000B
DW 0000010001000000B
DW 0000001010000000B
DW 0000001010000000B
DW 0000010001000000B
DW 0000100100100000B
DW 0001001110010000B
DW 0001001110010000B
DW 0000000000000000B
DW 0011111111111000B
DW 0000000000000000B

{ -------------- STRETCH CURSOR ------------- }
{ Hotspot }
DW 7, 7
{ Screen Mask }
DW 1111111011111111B
DW 1111110001111111B
DW 1111100000111111B
DW 1111110001111111B
DW 1111110001111111B
DW 1101110001110111B
DW 1000000000000011B
DW 0000000000000001B
DW 1000000000000011B
DW 1101110001110111B
DW 1111110001111111B
DW 1111110001111111B
DW 1111100000111111B
DW 1111110001111111B
DW 1111111011111111B
DW 1111111111111111B

{ Cursor Mask }
DW 0000000000000000B
DW 0000000100000000B
DW 0000001110000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0010000100001000B
DW 0111111111111100B
DW 0010000100001000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000000100000000B
DW 0000001110000000B
DW 0000000100000000B
DW 0000000000000000B
DW 0000000000000000B

{ -------------- SMILEY CURSOR ------------- }
{ Hotspot }
DW 7, 7
{ Screen Mask }
DW 1111111001111111B
DW 1111100000011111B
DW 1111000000001111B
DW 1110000110000111B
DW 1100000110000011B
DW 1000000000000001B
DW 0000000110000000B
DW 0001001111001000B
DW 0001110000111000B
DW 0001110000111000B
DW 0000100000010000B
DW 1000000000000001B
DW 1100000000000011B
DW 1110000000000111B
DW 1111000000001111B
DW 1111100000011111B

{ Cursor Mask }
DW 0000000000000000B
DW 0000000110000000B
DW 0000011001100000B
DW 0000100000010000B
DW 0001000000001000B
DW 0010011001100100B
DW 0010010000100100B
DW 0100000110000010B
DW 0100000110000010B
DW 0100000110000010B
DW 0010010000100100B
DW 0010011111100100B
DW 0001001111001000B
DW 0000100000010000B
DW 0000011111100000B
DW 0000000000000000B

{ -------------- HAND CURSOR ------------- }
{ Hotspot }
DW 3, 1
{ Screen Mask }
DW 1110111111111111B
DW 1100011111111111B
DW 1100011111111111B
DW 1100011111111111B
DW 1100000011111111B
DW 1100000000111111B
DW 1100000000011111B
DW 1000000000011111B
DW 0000000000011111B
DW 0000000000011111B
DW 0000000000011111B
DW 0000000000011111B
DW 0000000000011111B
DW 1000000000111111B
DW 1100000000111111B
DW 1100000000111111B

{ Cursor Mask }
DW 0000000000000000B
DW 0001000000000000B
DW 0001000000000000B
DW 0001000000000000B
DW 0001000000000000B
DW 0001010100000000B
DW 0001010101000000B
DW 0001010101000000B
DW 0101010101000000B
DW 0101010101000000B
DW 0111111111000000B
DW 0111111111000000B
DW 0111111111000000B
DW 0011111110000000B
DW 0001111110000000B
DW 0000000000000000B

{ -------------- PEN CURSOR ------------- }
{ Hotspot }
DW 1, 1
{ Screen Mask }
DW 0011111111111111B
DW 0000111111111111B
DW 1000011111111111B
DW 1000000111111111B
DW 1100000011111111B
DW 1110000001111111B
DW 1110000000111111B
DW 1111000000011111B
DW 1111100000001111B
DW 1111110000000111B
DW 1111111000000011B
DW 1111111100000001B
DW 1111111110000000B
DW 1111111111000000B
DW 1111111111100001B
DW 1111111111110011B

{ Cursor Mask }
DW 0000000000000000B
DW 0100000000000000B
DW 0011000000000000B
DW 0011100000000000B
DW 0001111000000000B
DW 0000100100000000B
DW 0000100010000000B
DW 0000010001000000B
DW 0000001000100000B
DW 0000000100010000B
DW 0000000010001000B
DW 0000000001000100B
DW 0000000000100010B
DW 0000000000010010B
DW 0000000000001100B
DW 0000000000000000B

@end:
End;

Procedure SetMousePos(x, y : Integer); Assembler;
Asm
CALL GetgraphMode { Find out the gfx mode }
MOV cx, x { X value passed }
MOV dx, y { Y Value passed }
CMP ax, $FFFF { Are we in text mode? }
JNE @ready { If not in text mode, skip the next bit }

SUB cx, 1 { X: Make zero-based }
SHL cx, 3 { X: Multiply by 8 }
SUB dx, 1 { Y: Make zero-based }
SHL dx, 3 { Y: Multiply by 8 }

@ready:
MOV ax, 4h { Set pos subfunction }
INT 33h { Call MS Mouse driver }
End;

Procedure WaitLMouseClick(maxtime : Integer); Assembler;
Asm
@lbl1:
CALL LMouseDown { Is Left button down? }
CMP ax, 1 { Find out if it is }
JNE @lbl1 { If not, loop round }

MOV ax, 0 { Get ticks function }
INT 1Ah { Call clock interrupt }
PUSH dx { Store value }

@lbl2:
CALL LMouseDown { Is it back up? }
CMP ax, 1 { Is it then? }
JE @lbl2 { If not, loop }

MOV ax, 0 { Get ticks function }
INT 1Ah { Call clock interrupt }
MOV ax, dx { New value in AX }
POP dx { Old value in DX }
SUB ax, dx { Find difference }
MOV bx, 50 { 1 tick = 50ms }
MUL bx { Convert to milliseconds }
CMP ax, maxtime { Are we within time limits? }
JG @lbl1 { If timed out, start all over again }
End;

Procedure WaitRMouseClick(maxtime : Integer); Assembler;
Asm
@lbl1:
CALL RMouseDown { Is right button down? }
CMP ax, 1 { Find out if it is }
JNE @lbl1 { If not, loop round }

MOV ax, 0 { Get ticks function }
INT 1Ah { Call clock interrupt }
PUSH dx { Store value }

@lbl2:
CALL RMouseDown { Is it back up? }
CMP ax, 1 { Is it then? }
JE @lbl2 { If not, loop }

MOV ax, 0 { Get ticks function }
INT 1Ah { Call clock interrupt }
MOV ax, dx { New value in AX }
POP dx { Old value in DX }
SUB ax, dx { Find difference }
MOV bx, 50 { 1 tick = 50ms }
MUL bx { Convert to milliseconds }
CMP ax, maxtime { Are we within time limits? }
JG @lbl1 { If timed out, start all over again }
End;

Procedure WaitMouseClick; Assembler;
Asm
PUSH 250 { Default is 250ms }
CALL WaitLMouseClick { Call the function }
End;

Function CheckDoubleClick : Boolean; Assembler;
Asm
PUSH 400 { Default time 400ms }
CALL CheckDblLClick { Call the function }
End;

Procedure WaitDoubleClick; Assembler;
Asm
@lbl:
CALL WaitMouseClick { Wait for mouse down }
CALL CheckDoubleClick { Is there a dbl click? }
CMP ax, 0 { Is there not? }
JE @lbl { Loop if not }
End;

Function GetMouseX : Integer; Assembler;
Asm
MOV ax, 3 { Get Mouse state function }
INT 33h { Call MS Mouse interrupt }
PUSH cx { Store X pos }

CALL GetgraphMode { Find out gfx mode }
CMP ax, $FFFF { Is it text mode? }
POP ax { Put X-pos back in AX }
JNE @end { If not, just exit }

SHR ax, 3 { Divide by 8 }
ADD ax, 1 { Make 1-based }

@end:
End;

Function GetMouseY : Integer; Assembler;
Asm
MOV ax, 3 { Get Mouse state function }
INT 33h { Call MS Mouse interrupt } PUSH dx { Store Y pos }

CALL GetgraphMode { Find out gfx mode }
CMP ax, $FFFF { Is it text mode? }
POP ax { Put Y-pos back in AX }
JNE @end { If not, just exit }

SHR ax, 3 { Divide by 8 }
ADD ax, 1 { Make 1-based }
@end:
End;

Function MouseInRect(x1, y1, x2, y2 : Integer) : Boolean; Assembler;
Asm
CALL GetMouseX { Determine X-Pos }
CMP ax, x1 { Compare with min x }
JL @false { Bail out now if outside limit }
CMP ax, x2 { Compare with max x }
JG @false { Bail out now if outside limit }

CALL GetMouseY { Determine Y-Pos }
CMP ax, y1 { Compare with min y }
JL @false { Bail out now if outside limit }
CMP ax, y2 { Compare with max y }
JG @false { Bail out now if outside limit }

MOV ax, 1 { Return TRUE }
JMP @end

@false:
MOV ax, 0 { Return FALSE }
@end:
End;

End.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

RE:String solo 256?

Publicado por Willy (177 intervenciones) el 07/01/2008 01:42:57
Disculpen!

Creo que en esta página hace falta poder subir archivos.
Sólamente me falta una muy pequeña.
Esta sí es mía.

Unit Graficas;
Interface
uses crt,graph;
Procedure IniciaGraficas;
Procedure RandomGround(X1,Y1,X2,Y2 : integer; Color1, Color2 : byte);
Implementation


Procedure IniciaGraficas;
var GraphDriver, GraphMode : integer;
begin
GraphDriver := Detect; InitGraph(GraphDriver ,GraphMode, ' ');
if GraphResult <> grOK then
begin
clrscr;
Writeln('Mensaje: Error de gr ficas. No se ecuentra EGAVGA.BGI');
repeat until keyPressed;
Halt(1)
end;

end;

Procedure RandomGround(X1,Y1,X2,Y2 : integer; Color1, Color2 : byte);
var X, Y : integer;
begin
Randomize;
for X := X1 to X2 do
begin
for Y := Y1 to Y2 do
begin
if random < 0.5 then PutPixel(X, Y, Color1)
else PutPixel(X, Y, Color2);
end;{for Y}
end;{for X}
end;

end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:String solo 256?

Publicado por dania (1 intervención) el 20/05/2010 16:11:52
setcolor en turbo pascal
setfillstyle en turbo pascal
flood fill en turbo pascal
PROGRAMACION
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar