Генератор корней

← →
rts111 © (2005-01-31 21:58) [0]

Предлогаю вниманию бесполезную программу:
http://galaxy3000.narod.ru/RootGenerator.exe

← →
rts111 © (2005-01-31 22:02) [1]

Размер программы 12 Kb.

← →
Gero © (2005-01-31 22:06) [2]

Все уже побежали качать неизвестный exe-файл.

← →
rts111 © (2005-01-31 23:56) [3]

Хоть кто-нибудь скачал?
f

← →
Vlad © (2005-02-01 00:00) [4]

> rts111 © (31.01.05 23:56) [3]

Ты же сказал что она бесполезная?

← →
Gero © (2005-02-01 00:03) [5]

Видимо, что тех, кто ее скачал, мы не услышим.

← →
rts111 © (2005-02-01 00:28) [6]

Не совсем бесполезная, можно например в каком-нибудь графическом
редакторе поверх рисунка сгенерировать корень или сухое дерево.
Программа написана без использования VCL.

← →
rts111 © (2005-02-01 02:08) [7]

Скриншот:
http://galaxy3000.narod.ru/root1.jpg
f

← →
GrayFace © (2005-02-01 02:23) [8]

rts111
Хорошие корни. Твоя прога?
Как-то интересно там Clear работает...

← →
rts111 © (2005-02-01 15:54) [9]

Clear вызывает процедуру InvalidateRect(0,nil,False);

← →
rts111 © (2005-02-01 15:54) [10]

Clear вызывает процедуру InvalidateRect(0,nil,False);

← →
GrayFace © (2005-02-01 17:07) [11]

А зачем перерисовывать все, кроме своего окна? Очищения-то никакого нету.

← →
Diabolik © (2005-02-02 05:32) [12]

Думаю программа будет интересна школьникам изучающим биологию и пишущим рефераты с картинками ;)

← →
Kerk © (2005-02-02 05:40) [13]

Кнопка Clear не работает (WinXP Prof + SP1)

← →
Cosinus © (2005-02-02 09:37) [14]

Прикольно.
А-ля фракталы? Алгоритм сам писал?
ИМНО интерфейс не очень... То есть его как такого вообще нет, но алгоритм работает хорошо.

Я думаю что группа Корни оценит и вознаградит автора этой полезной программы с большой буквы.

Может кто подскажет, что нужно сделать что-бы работало на любом комп.

Текст программы:

program RootGenerator;
uses Windows,Messages,Unit1 in "Unit1.pas";

const wm_root = wm_User + 123;
wm_kbmy = wm_User + 124;

var WClass01 :TWndClass;
hw0 :HWnd;
hb0 :HWnd;
Message :TMsg;
hh_m :hhook=0;
hh_K :hhook=0;

procedure ShowRootGeneratorHelp;
begin MessageBox(0,
"Щелкните правой кнопкой мыши любое окно или наведите мышь на любое окно,"+#10+
"и нажмите одну из клавиш: "вверх","вниз","вправо","влево""+#10+#10+
"Очистить все: "Esc"."+#10+
"Клавиши изменения размера: "+","-"."+#10+
"Клавиши изменения направления: "вверх","вниз","вправо","влево"."+#10+#10+
"Чтобы сохранить изображение рабочего стола в буфере обмена нажмите: "Print Screen"",
"Root generator help",MB_TOPMOST);
end;

function M_hook(code,wParam,lParam:integer):LongInt;stdcall;
begin
if code<0 then begin Result:=CallNextHookEx(hh_m,code,wParam,lParam);exit;end;
result:=0;
case wParam of
WM_RBUTTONDOWN:begin
sendmessage(FindWindow("w000","Root Generator (F1-help)"),wm_root,0,0);
result:=1;
end;
WM_RBUTTONUP:begin
SetWindowPos(FindWindow("w000","Root Generator (F1-help)"),HWND_TOPMOST,0,0,0,0,$43);
result:=1;
end;
end;//case
end;

function K_hook(code,wParam,lParam:integer):LongInt;stdcall;
begin
if code<0 then begin Result:=CallNextHookEx(hh_k,code,wParam,lParam);exit;end;
result:=0;
if (lParam and $80000000)=0 then
if byte(wParam)in[27, 37,38,39,40, 107,109, 187,189, vk_f1]
then begin
sendmessage(FindWindow("w000","Root Generator (F1-help)"),wm_kbmy,wParam,0);
result:=1;
end;
end;

function WindowP1(hw:HWnd;Message,WParam:Word;LParam:LongInt):LongInt;stdcall;
begin
result:=0;
case Message of
wm_Destroy:
begin
InvalidateRect(0,nil,False);
if hh_m<>0 then UnhookWindowsHookEx(hh_m);
if hh_k<>0 then UnhookWindowsHookEx(hh_k);
PostQuitMessage(0);
Exit;
end;
wm_Command :if lParam=hb0 then InvalidateRect(0,nil,False);
WM_lBUTTONDOWN,WM_ROOT :GenerateRoot;
wm_kbmy:
case WParam of
27 :InvalidateRect(0,nil,False);
37 :begin lastConer:=pi; GenerateRoot;end;
38 :begin lastConer:=-pi/2; GenerateRoot;end;
39 :begin lastConer:=0; GenerateRoot;end;
40 :begin lastConer:=pi/2; GenerateRoot;end;
107,187 :inc(rootsize);
109,189 :dec(rootsize);
VK_F1 :ShowRootGeneratorHelp;
end;//case
end;//case
result:=DefWindowProc(hw,Message,WParam,LParam);
end;

begin// начало программы

Randomize;
with WClass01 do
begin
lpfnWndProc :=@WindowP1;
cbClsExtra :=0;
cbWndExtra :=0;
hInstance :=0;
hCursor :=LoadCursor(0,idc_Arrow);
hbrBackground :=GetStockObject(LTGRAY_BRUSH);
lpszMenuName :="";
lpszClassName :="w000";
end;

If RegisterClass(WClass01)=0 then Halt (255);

hw0:=CreateWindow("w000","Root generator (F1-help)",WS_OVERLAPPEDWINDOW,20,20,600,530,0,0,HInstance,nil);

hb0:=CreateWindow("Button","Clear",$50001000,3,3,60,30,hw0,0,hInstance,nil);

SetWindowPos(hw0,HWND_TOPMOST,0,0,0,0,$43);

hh_m:=SetWindowsHookEx(WH_MOUSE ,M_hook,HInstance,0);
hh_K:=SetWindowsHookEx(WH_KEYBOARD,K_hook,HInstance,0);

while GetMessage(Message,0,0,0) do
begin
TranslateMessage(Message);
DispatchMessage(Message);
end;
Halt(Message.wParam);

end.

Кстати, корни с направлением вверх - очень хорошие кустики %)

Оцените генератор букетов(скрины):

http://galaxy3000.narod.ru/tree000.jpg
http://galaxy3000.narod.ru/tree001.jpg

Продолжение программы "генератор корней" (OpenGL) - 246 Kb.:
http://galaxy3000.narod.ru/flora3d.rar
Скрин:
http://galaxy3000.narod.ru/tree100.jpg

Генератор корней Найти похожие ветки