Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+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
+91
while usedthrds<>cn do
begin
i:=i+1;
if manual=0 then
if i>ccpun then
break;
if manual=1 then
begin
gotoxy(1,stroka);read(cputime[i]);
end
else
begin
gotoxy(1,stroka);write(cputime[i]);
end;
realsumcpu:=cputime[i]+ost;
sumcpu:=cputime[i]+ost;
found:=0;
bin:=0;
min:=1;max:=cn;
search:
while (min<=max) and (found=0) do
begin
bin:=bin+1;
mid:=(min+max)div 2;
if sumcpu<sortedthrd[mid] then
max:=mid-1
else
if sumcpu>sortedthrd[mid] then
min:=mid+1
else
if used[mid]=1 then
begin
if mid<>cn then
begin
l:=1;
while sortedthrd[mid+l]=sortedthrd[mid] do
begin
if used[mid+l]<>1 then
begin
mdldmas:=sortedthrd[mid+l];
mdldnum:=sortednum[mid+l];
ost:=realsumcpu-mdldmas;
used[mid+l]:=1;
found:=1;break;
end;
l:=l+1;
if mid+l>cn then break;
end;
end;
if (mid<>1) and (found=0) then
begin
l:=1;
while sortedthrd[mid-l]=sortedthrd[mid] do
begin
if used[mid-l]<>1 then
begin
mdldmas:=sortedthrd[mid-l];
mdldnum:=sortednum[mid-l];
ost:=realsumcpu-mdldmas;
used[mid-l]:=1;
found:=1;break;
end;
l:=l+1;
if mid-l<1 then break;
end;
end;
break;
end
else
begin
mdldmas:=sortedthrd[mid];
mdldnum:=sortednum[mid];
used[mid]:=1;
ost:=realsumcpu-mdldmas;
found:=1;
break;
end;
end;
if (found=0) and (sumcpu>0) then
begin
sumcpu:=sumcpu-1;bin:=0;min:=1;max:=cn;
goto search;
end;
if found=0 then
ost:=realsumcpu
else
begin
gotoxy(6,stroka);write (realsumcpu);gotoxy (12,stroka);write (mdldmas);gotoxy(18,stroka);write(mdldnum);gotoxy(24,stroka);write(ost);gotoxy(30,stroka);write(bin);
stroka:=stroka+1;
end;
if found=1 then
begin
realsumcpu:=ost;
sumcpu:=ost;
found:=0;bin:=0;min:=1;max:=cn;
goto search;
end;Как студенты пишут сортировку (полная версия https://gist.github.com/Karasiq/11184652)
jkhne4pijgberg,
22 Апреля 2014
+80
Procedure ChangeDataBase(var phone:cellphone);
var ch:char;
Begin clrscr;
With Phone do
Begin Line;
TextColor(Cyan); Writeln(' Выберите тип аппарата: '); TextColor(White);
Writeln(' [0-Телефон | 1-Смартфон]');
Repeat
Ch:=Readkey;
if (Ch in [#48,#49]) then
Begin
if (Ch = #48) then Types:=('Телефон');
if (Ch = #49) then Types:=('Смартфон');
end
else
Begin
TextColor(Red); Writeln(' ОШИБКА: Неверный диапазон! Повторите ввод...')
end;
Until (Ch in [#48,#49]);
TextColor(Cyan); Write(' Тип аппарата: ');TextColor(Yellow); Writeln(Types); Line;
TextColor(Cyan); Write(' Производитель: '); TextColor(Yellow); Readln(Maker);
TextColor(Cyan); Write(' Модель: '); TextColor(Yellow); Readln(Model);
Line;
TextColor(Cyan); Writeln(' Выберите тип корпуса: '); TextColor(White);
Writeln(' [0-Классический | 1-Раскладной | 2-Слайдер]');
Repeat
Ch:=Readkey;
if (Ch in [#48..#50]) then
Begin
if (Ch = #48) then Body:=('Классический');
if (Ch = #49) then Body:=('Раскладной');
if (Ch = #50) then Body:=('Слайдер');
end
else
Begin
TextColor(Red); Writeln(' ОШИБКА: Неверный диапазон! Повторите ввод...')
end;
Until (Ch in [#48..#50]);
TextColor(Cyan); Write(' Тип корпуса: ');TextColor(Yellow); Writeln(Body); Line;
TextColor(Cyan); Writeln(' Выберите операционную систему: '); TextColor(White);
Writeln(' [0-Asha | 1-Android | 2-Bada OS | 3-iOS | 4-Symbian ]');
Writeln(' [5-Windows Phone 7 | 6-Windows Phone 8 | 7-Другая]');
Repeat
Ch:=Readkey;
if (Ch in [#48..#55]) then
Begin
if (Ch = #48) then Os:=('Asha');
if (Ch = #49) then Os:=('Android');
if (Ch = #50) then Os:=('Bada OS');
if (Ch = #51) then Os:=('iOS');
if (Ch = #52) then Os:=('Symbian');
if (Ch = #53) then Os:=('Windows Phone 7');
if (Ch = #54) then Os:=('Windows Phone 8');
if (Ch = #55) then Os:=('Другая');
end
else
Begin
TextColor(Red); Writeln('ОШИБКА: Неверный диапазон! Повторите ввод...')
end;
Until (Ch in [#48..#55]);
TextColor(Cyan); Write(' Операционная система: ');TextColor(Yellow); Writeln(Os); Line;
TextColor(Cyan); Write(' Цена: '); TextColor(Yellow); Readln(Price);
end;
LastGlobalMenu; {Возврат в основное меню}
end;
Serjant,
22 Апреля 2014
Follow us!