Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+91
for li:=LL-2 downto 1 do
begin
ag:=ml_(a[li], m_(gen(len(a[li]), 1, 1), a[li]) );
cp(
b[li],
ml_(
ml(
t(W[li]),
from2(b[li+1], li <> LL-2)
)
,
ag
)
);
end;Функциональное программирование в императивном стиле.
icune,
18 Июня 2014
+92
type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
ListBox1: TListBox;
Button2: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TListThread = class(TThread)
protected
procedure Execute; override;
end;
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
TYouThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form1: TForm1;
threadList1: TThreadList;
mythreadRunning, youthreadRunning, listThreadRunning: Boolean;
globalCount: Integer;
listProcess: TListThread; { TListThread is a custom descendant of TThread. }
secondProcess: TMyThread; { TMyThread is a custom descendant of TThread. }
otherSecondProcess: TYouThread; { TMyThread is a custom descendant of TThread. }
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if (mythreadRunning = FALSE) then
begin
mythreadRunning:= TRUE;
secondProcess := TMyThread.Create(True); { Create suspended--secondProcess does not run yet. }
secondProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
secondProcess.Priority := tpLower; // Set the priority to lower than normal.
secondProcess.Resume; { Now run the thread. }
end
else
MessageDlg('This thread is still running. You are going to hurt yourself!',
mtInformation, [mbOk], 0);
end;
procedure TMyThread.Execute;
var
I: Integer;
myRadio: TRadioButton;
begin
for I := 0 to 20 do
begin
if (Terminated) then
begin
mythreadRunning:= FALSE;
exit;
end;
myRadio:= TRadioButton.Create(Form1);
globalCount:= globalCount + 1;
myRadio.Name:= 'RadioButton' + IntToStr(globalCount);
threadList1.Add(myRadio);
Sleep(1000);
end;
mythreadRunning:= FALSE;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (listthreadRunning = FALSE) then
begin
listThreadRunning:= TRUE;
listProcess := TListThread.Create(True); { Create suspended--secondProcess does not run yet. }
listProcess.FreeOnTerminate := True; { You do not need to clean up after termination. }
listProcess.Priority := tpLower; // Set the priority to lower than normal.
listProcess.Resume; { Now run the thread. }
end;
end;
procedure TListThread.Execute;
var
I: Integer;
Temp: TControl;
myList: TList;
begin
while(True) do
begin
http://docwiki.embarcadero.com/CodeExamples/XE5/en/TThreadList_%28Delphi%29
Беда, когда примеры пишут психически неполноценные люди. Самое ужасное то, что этот "пример" висит на сайте embarcadero.
brutushafens,
17 Июня 2014
+84
type
TSearchF = class(TThread)
private
protected
procedure Execute; override;
public
Str: String; // думаю назначение обоих
Pause: Boolean; // параметров объяснять не надо
end;
и
Код:
procedure TSearchF.Execute;
begin
while not Terminated do
begin
if(Pause) then
begin
Sleep(10);
end else
begin
FindFile(Str);
end;
end;
end;
http://www.programmersforum.ru/showthread.php?t=91543
Без комментариев.
brutushafens,
17 Июня 2014
+98
procedure TForm1.FormCreate(Sender: TObject);
var
H: THandle;
R: TRect;
appbardata: tappbardata;
begin
sx := 0;
sy := 0;
ax := 0;
ay := 0;
sh := GetSystemMetrics(SM_CYSCREEN);
ZeroMemory(@appbardata, SizeOf(tappbardata));
SHAppbarmessage(5, appbardata);
If appbardata.rc.TopLeft.X > 1 then
begin
ax := appbardata.rc.BottomRight.X - appbardata.rc.TopLeft.X;
ax:=ax+4;
end
else
ax:=6;
If appbardata.rc.TopLeft.y > 1 then
begin
ay := appbardata.rc.BottomRight.y - appbardata.rc.TopLeft.y;
ay:=ay+4;
end
else
ay:=6;
sx := (GetSystemMetrics(SM_CXSCREEN)-form1.ClientWidth-ax);
sy := (GetSystemMetrics(SM_CYSCREEN)-form1.ClientHeight-ay);
Form1.left := sx;
Form1.Top :=sy;
end;
Выравнивание всплывающего окошка точно по правому краю.
Даже не знаю, гк ли это, ибо глаз не видит себя. Но смотрится очень странно, почти как хак.
brutushafens,
10 Июня 2014
+83
var
ABuffer: PAnsiChar;
AText: PAnsiChar;
BBuffer: PAnsiChar;
begin
ABuffer := 'TEST';
BinToHex(ABuffer, AText, Length(ABuffer));
ShowMessage(AText);
ShowMessage(IntToStr(Length(AText)));
GetMem(BBuffer, Length(AText) div 2);
HexToBin(AText, BBuffer, Length(AText) div 2);
BBuffer[Length(BBuffer) - 1] := #0;
ShowMessage(IntToStr(SizeOf(BBuffer)));
ShowMessage(BBuffer);
FreeMem(BBuffer);
end;
http://www.sql.ru/forum/653685/bintohex-i-hextobin-delphi2009
Возможно, я ошибаюсь, но по-моему код - лажа; насколько я понимаю, указатель "AText: PAnsiChar;" всего лишь УКАЗАТЕЛЬ, под него нигде в коде не выделяется память, автор юзает его как простую переменную.
И никто его не поправил. Вроде думающие люди.
brutushafens,
25 Мая 2014
+89
var
Form1: TForm1;
i:integer; // глобальные переменные - "общие"
CritSec:TCriticalSection; // объект критической секции
implementation
{$R *.dfm}
procedure ThreadFunc;
begin
while (i<100000) do
begin
CritSec.Enter; // открываем секцию
i:=i+1; //увеличиваем i
Form1.Label1.Caption:=IntToStr(i); //из потока к элементам формы нужно обращаться через имя формы
CritSec.Leave; // закрываем
end;
endthread(0); // красиво выходим из потока.
end;
procedure TForm1.Button1Click(Sender: TObject);
var tid1,tid2,id:longword;
begin
i:=0;
tid1:=beginthread(nil,0,Addr(ThreadFunc),nil,0,id); //запускаем функцию ThreadFunc в потоке
tid2:=beginthread(nil,0,Addr(ThreadFunc),nil,0,id); //в tid2 присваиваем Идентификатор потока, который пригодится позже.
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CritSec:=TCriticalSection.Create; // создаём объект критической секции, на всё время работы программы
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CritSec.Free; // разрушаем
end;
end.
Уебище, блять, лесное.
http://grabberz.com/showthread.php?t=24619
brutushafens,
14 Мая 2014
+86
begin
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Генераторы шумовых сигналов');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Низкочастотные генераторы сигналов');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Усилители мощности');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Акустические излучатели');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Измерители шума и вибраций (шумомеры)');
if CheckListBox1.checked[0]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2] or CheckListBox3.checked[0]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Селективные микровольтметры, измерительные приемники (анализаторы спектра)');
if CheckListBox1.checked[0] or CheckListBox1.checked[1] or CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[3]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Селективные нановольтметры');
if CheckListBox1.checked[2] or CheckListBox1.checked[2]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Измерительные микрофоны');
if CheckListBox1.checked[0] or CheckListBox1.checked[1]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[0]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Измерительные антенны');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
then Form2.Memo1.Lines.Add('Вибродатчики (акселерометры)');
if CheckListBox1.checked[0] or CheckListBox1.checked[1]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[0]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Измерительные пробники');
if CheckListBox1.checked[2] or CheckListBox1.checked[3]
or CheckListBox2.checked[0] or CheckListBox2.checked[1] or CheckListBox2.checked[2]
or CheckListBox3.checked[1] or CheckListBox3.checked[2]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Полосовые октавные фильтры со среднегеометри- ческими частотами 250, 500, 1000, 2000, 4000 Гц');
if CheckListBox1.checked[0] or CheckListBox1.checked[1]
or CheckListBox3.checked[0]
or CheckListBox5.checked[0] or CheckListBox5.checked[1] or CheckListBox5.checked[2]
then Form2.Memo1.Lines.Add('Осциллографы');
{ if Checklistbox6.Checked[0] or CheckListBox3.checked[0]
or CheckListBox4.checked[0]
then Form2.Memo1.Lines.Add('Программные средства формирования и контроля полномочий доступа в AC'); }
<font color="Red"> if CheckListBox2.checked[3] or CheckListBox2.checked[4]or CheckListBox2.checked[5]
or CheckListBox3.checked[0] or CheckListBox4.checked[0]
then Form2.Memo1.Lines.Add('Программные средства контроля целостности программ и программных комплексов');</font>
Вот так живут Америка с Европой.
http://www.delphisources.ru/forum/showthread.php?t=26142
brutushafens,
11 Мая 2014
+96
Var
h : THandle;
procedure TMain.FormCreate(Sender: TObject);
begin
begin
h := CreateMutex(nil, True, PChar(ExtractFileName(Application.ExeName)));
if WaitForSingleObject(h, 0)<>0 then
begin
ShowMessage(‘Программа уже запущена!’);
Application.Terminate;
CloseHandle(h);
end;
end;http://moron.1side.ru/programmirovanie/delphi/zapret-povtornogo-zapuska-programmy.php
brutushafens,
02 Мая 2014
+79
if (Grid.DataSource.DataSet.Name = 'tMMain')
or (Grid.DataSource.DataSet.Name = 'tMain')
then
Tg := Grid.DataSource.DataSet.FieldByName('ARTID').AsInteger
else
if Grid.DataSource.DataSet.Name = 'tAnalog' then
Tg := Grid.DataSource.DataSet.FieldByName('IDPROD').AsInteger
else
if Grid.DataSource.DataSet.Name = 'tPriceSet' then
Tg := Grid.DataSource.DataSet.FieldByName('IDPROD').AsInteger
else
if Grid.DataSource.DataSet.Name = 'tProd' then
Tg := Grid.DataSource.DataSet.FieldByName('ID').AsInteger
else
Tg := 0;
Крутое решение проблемы разных полей в разных источниках вызова.
А вы говорите виртуализация, перегрузка функций....
TikiRU,
29 Апреля 2014
+83
program FeyverkFirework;
{$R+}
uses
Crt, Graph;
var
GraphDriver, GraphMode, ErrorCode : Integer;
Ch : Char;
I, J, K, XStart, YStart : Integer;
XX,YY,CC : Array[1..1000] of Integer;
FX,FY,DX,DY : Array[1..70] of Real;
R, T, X, Y : Real;
procedure Explode (C : Integer);
begin
T := -Pi;
I := 0;
Repeat
I := I + 1;
DX[I] := Sin(T)*5;
DY[I] := Cos(T)*5;
FX[I] := X;
FY[I] := Y;
T := T + 0.15;
Until T > Pi;
K := 0;
Repeat
For J := 1 to I do
begin
If C = 0 then
PutPixel (Round(FX[J]),Round(FY[J]),0)
else
PutPixel (Round(FX[J]),Round(FY[J]),Random(GetMaxColor+1));
FX[J] := FX[J] + DX[J];
FY[J] := FY[J] - DY[J];
DY[J] := DY[J] - 0.2;
end;
K := K + 1;
Delay(10); { This was not in the original. }
Until Keypressed or (K > 50);
end;
procedure ShootFireWork;
begin
{ Delay (1000); }
Randomize;
T := Random / 2 - 0.25 + Pi/2;
X := XStart;
Y := YStart;
R := 20;
I := 0;
Repeat
Inc (I);
XX[I] := Round(X);
YY[I] := Round(Y);
CC[I] := GetPixel (XX[I],YY[I]);
If I > 1 then
If (XX[I] = XX[I-1]) and (YY[I] = YY[I-1]) then CC[I] := CC[I-1];
PutPixel (XX[I],YY[I],Random(GetMaxColor+1));
If I > 5 then
PutPixel (XX[I-5],YY[I-5],CC[I-5]);
X := X + Cos(T)*R;
Y := Y - Sin(T)*R;
If T > Pi/2 then
T := T + 0.02
else
T := T - 0.02;
R := R * 0.93;
Delay (20);
Until KeyPressed or (T < 0) or (T > Pi);
For J := I-5 to I do
PutPixel (XX[J],YY[J],CC[J]);
{ ch := readkey; }
Explode (1);
Explode (0);
end;
begin
GraphDriver := Detect;
InitGraph (GraphDriver, GraphMode, '..');
ErrorCode := GraphResult;
If ErrorCode <> grOk then
begin
Writeln ('Graphics Error: ',GraphErrorMsg(ErrorCode));
Halt;
end;
SetColor (GetMaxColor);
XStart := GetMaxX div 2;
YStart := GetMaxY - 20;
Repeat
ShootFireWork;
Until Keypressed;
Работает же! Красиво получается :)
Выполнить код можно здесь: http://pma.clan.su/index.html.
Алгоритм выполнения кода. Жмём E. Вводим код. Нажимаем в левом нижнем углу CoPas editor. Нажимаем R. Радуемся! :)
Mobac,
24 Апреля 2014
Follow us!