-
+86
- 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
procedure TForm1.FormCreate(Sender: TObject);
begin
panel27.Caption:=' ' + TimeToStr(time);
KeyPreview := true;
Form1.BorderStyle:=bsNone;
Form1.WindowState:=wsMaximized;
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
Images: array[0..25] of Timage;
i,p:integer;
begin
{Цикл для прорисовки канвы,идея безумная но иначе она прорисовывается не полностью}
{РАБОТАЕТ? НЕ ТРОГАЙ!©}
for i:=0 to 26 do
begin
images[0]:=image1;
images[1]:=image2;
images[2]:=image3;
images[3]:=image4;
images[4]:=image5;
images[5]:=image6;
images[6]:=image7;
images[7]:=image8;
images[8]:=image9;
images[9]:=image10;
images[10]:=image11;
images[11]:=image12;
images[12]:=image13;
images[13]:=image14;
images[14]:=image15;
images[15]:=image16;
images[16]:=image17;
images[17]:=image18;
images[18]:=image19;
images[19]:=image20;
images[20]:=image21;
images[21]:=image22;
images[22]:=image23;
images[23]:=image24;
images[24]:=image25;
images[25]:=image26;
if i>25
then PageControl1.ActivePageIndex:=0
else begin
PageControl1.ActivePageIndex:=i;
{Квадраты,Круг,Дуги}
images[i].Canvas.rectangle(200,50,300,150);
images[i].Canvas.rectangle(200,200,300,300);
images[i].Canvas.rectangle(200,350,300,450);
...
{Дальше идут канвас код которых примерно строк 150}
...
end;
p:=Gauge1.Progress+4;
if p<100 then
Gauge1.Progress:=p;
end;
timer2.Enabled:=false;
Gauge1.Progress:=100;
end;
Изначально суть была в том, что при запуске программы окно разворачивалось на весь экран и вырисовывалось изображение на имаге(точнее несколько...штук 26),которые находились на пейдж контроле с 26 табщитами, но т.к в конструкторе окно формы не огромных размеров то вырисовывалось изображение размером с это маленькое окно оставляя огромный пробел справа и снизу.Позже проблема решилась и на активной вкладке пейджконтрола вырисовка была правильной, но на остальных неактивных такой же как и вначале. Пришлось при запуске переключать табщиты и поочередно рисовать на канве, все это происходит за 2-3 секунды каждый раз при запуске программы..другого решения увы не нашел.
HiiamMarvin,
17 Октября 2014
-
+93
- 1
- 2
- 3
- 4
- 5
- 6
- 7
- 8
- 9
if (CurrentPlugin=nil) and (CurrentPlugin.FileName<>'InfoRTF.dll') and (CurrentPLugin.FileName<>'Preview.dll') then begin
if not ServerStoped then begin
uPluginControl.StopSession();
end;
if ClientLoaded then begin
ClientLoaded:=false;
StartDemo();
end;
end;
Смеяться на первой же строчке.
Привет Алексу.
hdkeeper,
17 Октября 2014
-
+91
- 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
program lab2;
const n = 5;
var i:integer;
var A, x1, dx:single;
var arrayX : array[1..n] of single;
var arrayY : array[1..n] of single;
begin
readln(A);
x1:= -1 * 2.2 * A;
dx:= A/5;
arrayX[1]:= x1;
for i:=2 to n do
arrayX[i]:= arrayX[i - 1] + dx;
for i:=1 to n do
begin
if (arrayX[i] < 0) then
arrayY[i]:= -1 * sqrt(sqrt(16 * sqr(sqr(A)) + 4 * sqr(A) * sqr(arrayX[i] + A)) - sqr(arrayX[i] + A) - sqr(A))
else
arrayY[i]:= sqrt(sqr(A) - sqr(arrayX[i] + A)) - 2 * A;
writeln(arrayX[i], ' ; ', arrayY[i]);
end;
readln;
end.
govno, govno, govnyanoe
GOVNOgovnyanoe,
13 Октября 2014
-
+88
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
program One;
var
a, b, c: integer;
begin
assign(input, 'input.txt'); reset(input);
assign(output, 'output.txt'); rewrite(output);
read(a);
if a = 5 then
Writeln('25')
else if (a div 5 = 1)
then
Writeln('Введите число, оканчивающееся на 5!')
else begin
b := a div 10;
c := b * (b + 1);
Writeln(c, '25');
end;
end.
Dexius,
06 Октября 2014
-
+97
- 1
- 2
var
TCPLength: boolean;
Ага. Длина либо есть, либо нет.
youmych,
07 Августа 2014
-
+144
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
Program hren;
Var
i:integer;
k:string;
label
start;
begin
Start:
Repeat
Writeln('Введите пятизначное число');
readln(k);
Until ord(k[0])=5;
for i:=1 to 5 do
if (ord(k[i])<48) or (ord(k[i])>58) then goto start;
i:=ord(k[1])+ord(k[2])+ord(k[3])+ord(k[4])+ord(k[5])-48*5;
writeln(i);
read;
end.
Один чувак знакомый сидел да задачки решал из учебника и была типа, что нужно пользователю ввести за раз пятизначное число и что бы на экран вывелись все цифры задом наперёд. Ну, решение интересное, как мне показалось, он придумал. Другой чувак делил что-то, если не путаю, а этот использовал массив да кодовую страницу.
CodeStar,
16 Июля 2014
-
+96
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
procedure TRegistry.GetKeyNames(Strings: TStrings);
var
Len: DWORD;
I: Integer;
Info: TRegKeyInfo;
S: string;
begin
Strings.Clear; // Очистить список перед добавлением. Это пиздец, как важно!!! Программист не додумается сам очистить список.
if GetKeyInfo(Info) then
begin
SetString(S, nil, Info.MaxSubKeyLen + 1);
for I := 0 to Info.NumSubKeys - 1 do
begin
Len := Info.MaxSubKeyLen + 1;
RegEnumKeyEx(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
Strings.Add(PChar(S));
end;
end;
end;
Из registry.pas (Delphi 2009)
Все регистровые функции зашкварены этим, не знаю, как в семерке; это значит, что в цикле их без дерьма не поюзаешь.
Очень обидно.
brutushafens,
26 Июня 2014
-
+86
- 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
function IsMemoryCommitByAdress(const AAddress: Pointer): Boolean;
var
MemoryInfo: TMemoryBasicInformation;
begin
Result := False;
if not Assigned(AAddress) then
Exit;
VirtualQuery(AAddress, MemoryInfo, SizeOf(MemoryInfo));
Result := MemoryInfo.State and MEM_COMMIT <> 0;
end;
function IsPointerToVMT(const APointer: Pointer): Boolean;
var
VMTPointer, VMTPointerSelf: Pointer;
begin
Result := False;
if not IsMemoryCommitByAdress(APointer) then
Exit;
VMTPointer := APointer;
VMTPointerSelf := Pointer(Integer(VMTPointer) + vmtSelfPtr);
if not IsMemoryCommitByAdress(VMTPointer) then
Exit;
if not IsMemoryCommitByAdress(VMTPointerSelf) then
Exit;
if not IsMemoryCommitByAdress(PPointer(VMTPointerSelf)^) then
Exit;
Result := PPointer(VMTPointerSelf)^ = VMTPointer;
end;
function IsBadptr(apointer:pointer):boolean;
begin
Result := IsMemoryCommitByAdress(APointer) and IsPointerToVMT(PPointer(APointer)^);
end;
Функция, для определения качества указателя, в ситуации "один объект - несколько указателей".
Гк в том, что нет надежности - это все равно, что юзать IsBadReadPtr и аналогичные.
Почему-то никто не пытается использовать операторы is и as (я узнал о них благодаря Тарасу, спасибо ему), чтобы сравнить качество приведения.
brutushafens,
19 Июня 2014
-
+91
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
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
- 001
- 002
- 003
- 004
- 005
- 006
- 007
- 008
- 009
- 010
- 011
- 012
- 013
- 014
- 015
- 016
- 017
- 018
- 019
- 020
- 021
- 022
- 023
- 024
- 025
- 026
- 027
- 028
- 029
- 030
- 031
- 032
- 033
- 034
- 035
- 036
- 037
- 038
- 039
- 040
- 041
- 042
- 043
- 044
- 045
- 046
- 047
- 048
- 049
- 050
- 051
- 052
- 053
- 054
- 055
- 056
- 057
- 058
- 059
- 060
- 061
- 062
- 063
- 064
- 065
- 066
- 067
- 068
- 069
- 070
- 071
- 072
- 073
- 074
- 075
- 076
- 077
- 078
- 079
- 080
- 081
- 082
- 083
- 084
- 085
- 086
- 087
- 088
- 089
- 090
- 091
- 092
- 093
- 094
- 095
- 096
- 097
- 098
- 099
- 100
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
Follow us!