Новости | Об игре | Форум
03:53, 575 онлайн
Форумы » Общий Форум » Паскаль 

АвторТема: Паскаль
Golceper



 1 
   
  написано: 24.01.2005 19:31:29 
Вот прога.:)Дописываем кто чего Знает, придумываем и тут же воплощаем. Кто
незнает просьба неписать ваще!

Program Dopishi;
Var
a:=Integer;
b:=Integer;
Begin
Fertulop



 2 
   
  написано: 24.01.2005 19:33:23 
if a = b then
Golceper = кг\ам
Мертвецкий



 3 
   
  написано: 24.01.2005 19:33:38 
паскаль маст дай (с)
And_911



 4 
   
  написано: 24.01.2005 19:35:24 
while a<>0
case of b:
0-100: writeln('I'm the best player of www.gwars.io:)');
end;
blacknd



 5 
   
  написано: 24.01.2005 19:36:26 
Лучше так. Особенно по обглючке))

PROGRAM MYST;
USES CRT,GRAPH;
TYPE
POINT=RECORD
X,Y:INTEGER;
END;
CENTRES=ARRAY[1..10]OF POINT;
ARINT=ARRAY[1..10]OF INTEGER;
ARSTEP=ARRAY[1..10]OF REAL;
VAR
N,K,T,I,GD,GM:INTEGER;
C:CENTRES;
R:ARINT;
ST:ARSTEP;
PROCEDURE INIT;
VAR
I:INTEGER;
BEGIN
RANDOMIZE;
N:=RANDOM(6)+5;
K:=RANDOM(6)+5;
FOR I:=1 TO N DO
BEGIN
C[I].X:=RANDOM(640);
C[I].Y:=RANDOM(480);
R[I]:=RANDOM(400)+80;
ST[I]:=PI/(RANDOM(360)-180);
END;
END;
BEGIN
CLRSCR;
GD:=DETECT;
INITGRAPH(GD,GM,'D:\TP\BGI');
REPEAT
CLEARDEVICE;
INIT;
T:=0;
SETLINESTYLE(0,0,3);
REPEAT
SETCOLOR(BLUE);
FOR I:=1 TO N-1 DO

LINE(C[I].X+ROUND(R[I]*COS(ST[I]*T)),C[I].Y+ROUND(R[I]*SIN(ST[I]*T)),C[I+1].X+RO
UND(R[I+1]*COS(ST[I+1]*T)),
C[I+1].Y+ROUND(R[I+1]*SIN(ST[I+1]*T)));

LINE(C[1].X+ROUND(R[1]*COS(ST[1]*T)),C[1].Y+ROUND(R[1]*SIN(ST[1]*T)),C[N].X+ROUN
D(R[N]*COS(ST[N]*T)),
C[N].Y+ROUND(R[N]*SIN(ST[N]*T)));
IF (T>=K) THEN
BEGIN
SETCOLOR(BLACK);
FOR I:=1 TO N-1 DO

LINE(C[I].X+ROUND(R[I]*COS(ST[I]*(T-K))),C[I].Y+ROUND(R[I]*SIN(ST[I]*(T-K))),

C[I+1].X+ROUND(R[I+1]*COS(ST[I+1]*(T-K))),C[I+1].Y+ROUND(R[I+1]*SIN(ST[I+1]*(T-K
))));

LINE(C[1].X+ROUND(R[1]*COS(ST[1]*(T-K))),C[1].Y+ROUND(R[1]*SIN(ST[1]*(T-K))),C[N
].X+ROUND(R[N]*COS(ST[N]*(T-K))),
C[N].Y+ROUND(R[N]*SIN(ST[N]*(T-K))));
SETCOLOR(BLUE);
FOR I:=1 TO N-1 DO

LINE(C[I].X+ROUND(R[I]*COS(ST[I]*T)),C[I].Y+ROUND(R[I]*SIN(ST[I]*T)),C[I+1].X+RO
UND(R[I+1]*COS(ST[I+1]*T)),
C[I+1].Y+ROUND(R[I+1]*SIN(ST[I+1]*T)));

LINE(C[1].X+ROUND(R[1]*COS(ST[1]*T)),C[1].Y+ROUND(R[1]*SIN(ST[1]*T)),C[N].X+ROUN
D(R[N]*COS(ST[N]*T)),
C[N].Y+ROUND(R[N]*SIN(ST[N]*T)));
END;
T:=T+1;
UNTIL (KEYPRESSED);
UNTIL (READKEY=#27);
CLOSEGRAPH;
END.
Darth_Maul



 6 
   
  написано: 24.01.2005 19:36:30 
А инициализацию a и b кто будет делать? У вас коды кривые.

a:="Darth_Maul's the only one to find you, sweet"
blacknd



 7 
   
  написано: 24.01.2005 19:38:07 
Короче, The matrix has got Golceper.
blacknd



 8 
   
  написано: 24.01.2005 19:38:31 
Knock, knock, mlin))
Golceper



 9 
   
  написано: 24.01.2005 19:39:08 
:)) Оживленней Стало :)) У кого какие предложения еще?
WarLord Ka_Lin



 10 
   
  написано: 24.01.2005 20:35:16 
PUSH DS
SUB AX,AX
PUSH AX
MOV AX, DATASG
MOV DS, AX

MOV AH, 10
LEA DX,PRECNUM
INT 21H

MOV CL,PRECNUM+1
MOV SI, CX
hackBOT



 11 
   
  написано: 24.01.2005 20:37:04 
10. вах! крут! %)) а где скачать кряк к клиенту? %))
Leo Killer



 12 
   
  написано: 24.01.2005 20:39:52 
begin
Case a off
'kaa' : WriteLn("Самый большой боевой");
'луис': WriteLn("Самый большой производствкнный");
'pola': WriteLn("главный судья");
'Leo Killer' : WriteLn("Практикует лечение травами");
end;
......
DistortNeo



 13 
   
  написано: 24.01.2005 20:48:22 
process.pas
--------------

{$APPTYPE CONSOLE}

uses
SysUtils;

const
Stop = 2434;
CapPre = '<td class=wb align=left width=100%>&nbsp;&nbsp;<b>';
CapLast = '</b>';
ManPre = '&nbsp;&raquo;&nbsp;<b>Управляющий синдикатом:</b> <a
href=/info.php?id=';
StatPre = '&nbsp;&raquo;&nbsp;<b>Статус:</b> ';
StatLast = '<br>';

var
F, T: text;
I: integer;
Name, Manager, Status: string;

function Capture( const L, P: string ): string;
var
S: string;
LL, PP: integer;
begin
while not EOF( F ) do
begin
Readln( F, S );
LL := Pos( L, S );
if LL <> 0 then
begin
Delete( S, 1, LL + Length( L ) - 1 );
S := S + P;
PP := Pos( P, S );
Result := Copy( S, 1, PP - 1 );
Exit;
end;
end;
Result := '';
end;

begin
Assign( T, 'result.txt' );
Rewrite( T );
for I := 1 to Stop do
begin
Assign( F, 'List\' + IntToStr( I ) + '.htm' );
Reset( F );
Name := Capture( CapPre, CapLast );
Manager := Capture( ManPre, CapLast );
Delete( Manager, 1, Pos( '<b>', Manager ) + 2 );
Status := Capture( StatPre, StatLast );
if ( Manager <> '' ) and ( Name <> '' ) then Writeln ( '#', I, ': ',
Name, ' (', Status, '), владелец ', Manager, '<br>' );
Close( F );
end;
Close( T );
end.
DistortNeo



 14 
   
  написано: 24.01.2005 20:50:19 
unit GetSynsInfo;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, HttpProt;

type
TForm1 = class(TForm)
HttpCli1: THttpCli;
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
HttpCli2: THttpCli;
HttpCli3: THttpCli;
HttpCli4: THttpCli;
HttpCli5: THttpCli;
HttpCli6: THttpCli;
HttpCli7: THttpCli;
HttpCli8: THttpCli;
HttpCli9: THttpCli;
HttpCli10: THttpCli;
ListBox1: TListBox;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

const TrdNum = 10;
StrN = 90;
ColN = 17;

var Start,Stop: integer;
HTTP: array [1..10] of THttpCli;
//A: array [0..999] of integer;
B: array [1..10] of integer; { Status }
CurPtr,Size: integer;
FreeTrd: integer;

const Names: array [1..10] of string =
('roulet01.tmp','roulet02.tmp','roulet03.tmp',

'roulet04.tmp','roulet05.tmp','roulet06.tmp','roulet07.tmp','roulet08.t
mp',
'roulet09.tmp','roulet10.tmp');

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Start:=StrToInt(Edit1.Text);
Stop:=StrToInt(Edit2.Text);
Size:=Stop-Start+1;
CurPtr:=Stop;
// FillChar(A,SizeOf(A),0);
FillChar(B,SizeOf(B),0);
Image1.Picture.Bitmap.PixelFormat:=pf24bit;
Image1.Picture.Bitmap.Width:=Size;
Image1.Picture.Bitmap.Height:=2;
Image1.Picture.Bitmap.Canvas.Pen.Color:=clBlue;
Timer1.Enabled:=True;
FreeTrd:=TrdNum;
Button1.Enabled:=False;
end;

{function Process(Name: string): integer;
var S: string;
I: integer;
F: text;
Code: integer;
begin
Assign(F,Name);
Reset(F);
for I:=1 to StrN do Readln(F,S);
Delete(S,1,ColN-1);
I:=1;
S:=S+';';
while S[I] in ['0'..'9'] do Inc(I);
S:=Copy(S,1,I-1);
Val(S,Result,Code);
if (Code<>0) then Result:=-1;
Close(F);
Erase(F);
end;}

procedure WriteResults;
var F: text;
I: integer;
begin
{ Assign(F,'results.out');
Rewrite(F);
for I:=Start to Stop do Writeln(F,A[I-Start]);
Close(F);}
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var I,J: integer;
begin
ListBox1.Clear;
for I:=1 to TrdNum do
case Ord(HTTP[I].State) of
0: ListBox1.Items.Add('OK');
1: ListBox1.Items.Add('Not connected');
2: ListBox1.Items.Add('Connected');
3: ListBox1.Items.Add('DNS lookup');
4: ListBox1.Items.Add('DNS lookup done');
5: ListBox1.Items.Add('Waiting header');
6: ListBox1.Items.Add('Waiting body');
7: ListBox1.Items.Add('Aborting');
end;
ListBox1.Refresh;
for I:=1 to TrdNum do if (Ord(HTTP[I].State)=0) and (B[I]<>0) then
begin
HTTP[I].RcvdStream.Destroy;
HTTP[I].RcvdStream:=nil;
// A[B[I]-Start]:=Process(Names[I]);
Image1.Picture.Bitmap.Canvas.MoveTo(B[I]-Start,0);
Image1.Picture.Bitmap.Canvas.LineTo(B[I]-Start,2);
B[I]:=0;
Inc(FreeTrd);
end;
for I:=1 to TrdNum do if Ord(HTTP[I].State)=0 then HTTP[I].Abort;
if (FreeTrd=TrdNum) and (CurPtr<Start) then
begin
Timer1.Enabled:=False;
WriteResults;
Button1.Enabled:=True;
end;
while (CurPtr>=Start) and (FreeTrd>0) do
begin
for I:=1 to TrdNum do if B[I]=0 then
begin

HTTP[I].URL:='http://www.gwars.io/syndicate.php?id='+IntToStr(CurPtr);

HTTP[I].RcvdStream:=TFileStream.Create('List\'+IntToStr(CurPtr)+'.htm',fmCr
eate);
HTTP[I].GetASync;
B[I]:=CurPtr;
Dec(FreeTrd);
Dec(CurPtr);
Break;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
HTTP[1]:=HttpCli1;
HTTP[2]:=HttpCli2;
HTTP[3]:=HttpCli3;
HTTP[4]:=HttpCli4;
HTTP[5]:=HttpCli5;
HTTP[6]:=HttpCli6;
HTTP[7]:=HttpCli7;
HTTP[8]:=HttpCli8;
HTTP[9]:=HttpCli9;
HTTP[10]:=HttpCli10;
end;

end.
DistortNeo



 15 
   
  написано: 24.01.2005 20:51:02 
а код клиента я не буду постить
Leo Killer



 16 
   
  написано: 24.01.2005 20:52:57 
хе хе, дельфа форевер, побыстрому набрасал код шоб все заморочились :)
DistortNeo



 17 
   
  написано: 24.01.2005 21:04:32 
16
тогда уж лучше Perl
#!/usr/bin/perl
= <STDIN>;
=~
m/([0-9]+)\*x\*x\+([0-9]+)\*x\+([0-9]+)/;
if(( = $2*$2-4*$1*$3)>=0){
print
"x1=",(-$2+**0.5)/(2*$1),"\nx2=",(-$2-**0.5)/(2*$1),"\n"
}
else{
print "Решений нет!\n";
}

К списку тем