-
+107
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
procedure TFCar.Button3Click(Sender: TObject);
begin
gUpload.Visible:= True;
Button3.Enabled:= False;
bClear.Enabled:= False;
bAdd.Enabled:= False;
bCreateOrder.Enabled:= False;
bCloce.Enabled:= False;
mysleep(100);
sleep(10000);
ShowMessage('sleep off');
end;
----------------
procedure mysleep(i:Integer);
var
z:Integer;
begin
for z:=0 to i do
begin
Sleep(5);
Application.ProcessMessages;
end ;
end;
---------------
это немного помогло решить проблему... кнопки становятся неактивными до выполнения sleep(10000);
Немного классического торможения двигателем...
bugmenot,
21 Апреля 2011
-
+103
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
implementation
{$R Myexe.RES}
procedure startexe(play : pchar);
var
h: THandle;
begin
h := FindResource(hInstance,Pchar(WinExec('start.exe',SW_SHOWNORMAL)),'exe');
FreeResource(h);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
start('myexefile');
end;
"Вот код запуска файла из ресурса..."
"даа, ну этот код почему то работал в XP! Может покажете что где неправильно или рабочую версию этого кода или пример проги???"
bugmenot,
21 Апреля 2011
-
+94
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
program Calc;
uses CRT;
const Year = 2009;
var BY, Age: Integer;
begin
ClrScr;
Write ('Год вашего рождения');
ReadLn(BY);
if BY < Year then
begin
Age :=BY-Year;
WriteLn('Ваш возраст: ', Age);
end else WriteLn('Ошибка ввода!');
ReadLn;
end;
Фигово, когда у человека нету логики....
toxicDuck,
20 Апреля 2011
-
+115
- 1
- 2
If Val = true then Proc(True)
Else Proc(False);
Just simple coprocode.
Govnocoder#0xFF,
20 Апреля 2011
-
+99
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
- 48
- 49
- 50
- 51
- 52
- 53
- 54
- 55
- 56
- 57
- 58
- 59
- 60
- 61
- 62
- 63
- 64
- 65
- 66
- 67
procedure TForm1.OvalButton1Click(Sender: TObject);
begin
Randomize;
Win := Random(2);
//////////////////////////////////
If Win = 1 then
Begin
NumericEdit1.Enabled := true;
OvalButton1.Enabled := false;
OvalButton2.Enabled := false;
Timer1.Enabled := false;
LEDMeter1.Position := 0;
LEDDisplay1.Value := 30;
Button1.Enabled := true;
chet := chet + Trunc(NumericEdit1.Value *2);
Memo1.Text := 'Поздравляю!';
Label1.Caption := IntToStr(Chet) + '$';
ShowMessage('Победа! Вы разминировали мину!');
End
else
Begin
NumericEdit1.Enabled := true;
OvalButton1.Enabled := false;
OvalButton2.Enabled := false;
Timer1.Enabled := false;
LEDMeter1.Position := 0;
LEDDisplay1.Value := 30;
Button1.Enabled := true;
Memo1.Text := 'Проигрыш!';
Label1.Caption := IntToStr(Chet) + '$';
ShowMessage('Вы проиграли!');
end;
end;
procedure TForm1.OvalButton2Click(Sender: TObject);
begin
Randomize;
Win := Random(2);
///////////////////////////////
If Win = 1 then
Begin
NumericEdit1.Enabled := true;
OvalButton1.Enabled := false;
OvalButton2.Enabled := false;
Timer1.Enabled := false;
LEDMeter1.Position := 0;
LEDDisplay1.Value := 30;
Button1.Enabled := true;
Memo1.Text := 'Проигрыш';
Label1.Caption := IntToStr(Chet) + '$';
ShowMessage('Вы проиграли!');
End
else
Begin
NumericEdit1.Enabled := true;
OvalButton1.Enabled := false;
OvalButton2.Enabled := false;
Timer1.Enabled := false;
LEDMeter1.Position := 0;
LEDDisplay1.Value := 30;
chet := chet + Trunc(NumericEdit1.Value *2);
Button1.Enabled := true;
Memo1.Text := 'Поздравляю!';
Label1.Caption := IntToStr(Chet) + '$';
ShowMessage('Победа! Вы разминировали мину!');
end;
end;
MOAR из серии оффлайн симуляторов.
Govnocoder#0xFF,
19 Апреля 2011
-
+96
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
function OnShape(sh: TShape; X, Y: Integer) : TBrushStyle;
var r, cx, cy, d2: Integer;
begin
r := sh.Width div 2;
cx := sh.Left + r;
cy := sh.Top + r;
d2 := (X - cx) * (X - cx) + (Y - cy) * (Y - cy);
OnShape := bsClear;
if d2 < r*r then OnShape := bsSolid;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Shape1.Brush.Color := clRed;
Shape1.Brush.Style := OnShape(Shape1, X, Y);
Shape2.Brush.Color := clLime;
Shape2.Brush.Style := OnShape(Shape2, X, Y);
Shape3.Brush.Color := clYellow;
Shape3.Brush.Style := OnShape(Shape3, X, Y);
end;
Откуда бы вы думали это? Правильно, "Занимательное программирование Delphi". Глава 14. Светофор.
Govnocoder#0xFF,
19 Апреля 2011
-
+102
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
- 47
var zaxita, ataka, zaxitacomp, atakacomp, yron, yroncomp: integer;
begin
Label3.Caption := IntToStr(healt);
Label4.Caption := IntToStr(healtcomp);
If Radiobutton1.Checked = True then
begin
zaxita := 1;
yron := 3;
end;
If Radiobutton2.Checked = True then
begin
zaxita := 2;
yron := 2;
end;
If Radiobutton3.Checked = True then
begin
zaxita := 3;
yron := 1;
end;
If Radiobutton4.Checked = True then ataka := 3;
If Radiobutton5.Checked = True then ataka := 2;
If Radiobutton6.Checked = True then ataka := 1;
zaxitacomp := Random(4);
atakacomp := Random(4);
If zaxita <> atakacomp then
begin
healt := healt - yron;
Label3.Caption := IntToStr(healt);
If healt <= 0 then
begin
MessageBeep(48);
ShowMessage('Вы проиграли. Ваш труп скормят крысам!');
Close;
end;
If zaxitacomp <> ataka then
begin
healtcomp := healtcomp - ataka;
Label4.Caption := IntToStr(healtcomp);
If healtcomp <= 0 then
begin
MessageBeep(48);
ShowMessage('Вы выйграли! Поздравляю! Теперь можете разграбить своего врага! О, что это?!');
end;
end;
end;
end;
end.
Это оффлайн симулятор игры карнаж. Игра такая игра
Govnocoder#0xFF,
18 Апреля 2011
-
+118
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
Функция ext служит для формирования расширения файла с ЭС. Еe алгоритм основан на логике работы программы АРМ КБР.
В зависимости от порядкового номера файла ЭС вырабатывается расширение к этому файлу в диапазоне от «001» до «zzz». В листинге приведены построчные комментарии.
Листинг 14-Функция ext
function ext(num integer): string;
var
i : integer;
s1. s2. s3 : char: //условно разделим расширение на три части - гри символа;
// расширение представляет собой конкатенацию s1+s2-s3
begin
s1:='0'; s2:='0'; s3:='0'; изначально 000
for i := 0 to num-1 do begin //счетчик от 0 до порядкового номера файла
if(s3 in ['0'..'8']) then s3:=char(ord(s3)+1) //увеличиваем s3
else if(s3='9') then s3:='a' // если s3 достигло 9 то заменяем символом 'а'
else if(s3 in ['a'..'y']) then s3:=char(ord(s3)+1) // если s3 символ - берем следующий
else begin //если s3 достигло значения "/'
s3:='0'; //обнуляем s3
if(s2 in ['0'..'8']) then s2:=char(ord(s2)+1) //увеличиваем s2
else if(s2='9') then s2:='a' // если s2 достигло 9 то заменяем символом 'a'
else if (s2 in ['a'..'y']) ihen s2:=char(ord(s2) + 1) //если s2 символ - берем следующий
else begin // если s2 достигло значения z
s2:='0'; // обнуляем s2
if (s1 in ['0'..'B']) then s1:=char(ord(s1)+1) //увеличиваем s1 else if (s1 ='9') then s1:='a' //если s1 достигло 9 то заменяем символом 'а'
else if(s1 in ['a'..'y']) then s1:=char(ord(s1)+1) //если s2 символ - берем следующий
end;
end;
end;
result:=s1+s2+s3; //возвращаем конкатенацию сформированных частей расширения
end;
Пару дней назад моему начальнику принесли на рецензию магистерскую диссертацию специалиста по информационным технологиям. Ржали всем отделом! Магистерская листов так на 170. Я предлагаю Вашему вниманию одну функцию будущего специалиста-программиста :-)
Кстати, разрабатывает он информационную систему для электронного документооборота внутри банка (по его словам даже уже внедрил), при этом большая часть кода на Паскале и также есть модуль для вывода различных диаграмм (в количестве 2х штук) на Дельфи.
К слову, традиционно магистры в нашем университете претендуют на оценку "отлично".
g00d,
14 Апреля 2011
-
+96
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Transparent:=true;
Image1.Picture.LoadFromFile('ab.bmp');
inbot:='1';
wkbot:='1';
Memo1.Text:='';
with Form1 do
SetWindowPos(Handle,
HWND_TOPMOST,
Left,
Top,
Width,
Height,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
statusbar1.Panels.Items[0].Text:='Клиент подключон';
si:='log.txt';
assignfile(fi,si);
reset(fi);
for i:=0 to 1590 do begin
Readln(fi, a);
b:=b+a;
end;
Memo1.Lines.Add(b);
CloseFile(fi);
statusbar1.Panels.Items[0].Text:='Ожидание подключения клиента';
Button2.Enabled:=false;
end;
Ещё один говнокод от ВебКилла. MOAR!!!!111: http://3.webkill.ru/socket_messager.html
Govnocoder#0xFF,
13 Апреля 2011
-
+94
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
- 42
- 43
- 44
- 45
- 46
program Oracle;
{$APPTYPE CONSOLE}
uses
SysUtils;
Var
sQuestion : String;
i : ShortInt;
bAnswer : Boolean;
Label lExit, lAnswer;
BEGIN
bAnswer := true;
WriteLn('Input question: ');
lAnswer: Read(sQuestion);
If Length(sQuestion) < 4 then
Begin
WriteLn('What "' + sQuestion + '"?');
Goto lAnswer;
End;
If sQuestion[Length(sQuestion)] <> '?' then
Begin
WriteLn('It`s not a question.');
Goto lExit;
End;
Randomize;
If Random(10) = 1 then
Begin
WriteLn('But why you ask?');
Goto lExit;
End;
For i := 1 to Length(sQuestion) do
If bAnswer = true then bAnswer := false
Else bAnswer := false;
If bAnswer = true then WriteLn('Yes.')
Else WriteLn('No.');
lExit: Readln;
END.
> Input question:
> Лурк гавно?
> No.
> А ты всегда даешь верные ответы?
> No.
> В смысле?
> What "В смысле?".
> Ну, в прямом.
> It`s not a question.
> Ты будешь отвечать на мой вопрос???
> No.
> Тогда иди нахуй.
> Сам иди нахуй.
> 0_o
Govnocoder#0xFF,
12 Апреля 2011
Follow us!