Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Прочее";
Текущий архив: 2006.11.12;
Скачать: [xml.tar.bz2];

Вниз

Анимация "пожалуйста ждите"   Найти похожие ветки 

 
Гарри Поттер ©   (2006-10-21 11:21) [0]

Нужно обозначить ожидание выполнения процесса в программе какой-нибудь анимацией. Хотелось бы посимпотичнее. Курсор часиками не пойдет - форма небольшая. Может у кого-нибудь есть красивая гифка, иконка или набор кадров, поделитесь? Или ссылкой на ресурс, а то чето мне гугль не то выдает, может спрашиваю криво..


 
Ученик чародея ©   (2006-10-21 15:29) [1]

А чем прогресс бар и таймер с запасом времени со сбрасыванием в 0 при дохождении до конца прогресбара не подходит. Просто, стандартно, сердито...


 
TUser ©   (2006-10-21 16:45) [2]

{
 Печатает в консоль, даже если вывод перенаправлен,
 функциональность реализована только для Windows, Linux - сделоаю потом
}
unit uPrinter;

interface

// C - print in console, also when output was redirected
// A - print twice in console and (if redirection was used) to file
procedure WriteC (Value: string);
procedure WriteA (Value: string);
procedure WriteLnC (Value: string);
procedure WriteLnA (Value: string);

// write(ln) to a stdout if it was redirected
procedure WriteIfC (Value: string);
procedure WriteLnIfC (Value: string);

// true if standart output was redirected
var OutputWasRedirected: boolean;

implementation
{$ifdef WINDOWS}
uses Windows;
{$endif}

var Cons: textfile;

{$ifdef WINDOWS}
procedure SetRedirected;
var lpMode: dword;
begin
 OutputWasRedirected:=not GetConsoleMode(GetStdHandle(STD_OUTPUT_HANDLE),lpMode);
end;
{$else}
procedure SetRedirected;
begin
// do nothing; set OutputWasRedirected manually
 OutputWasRedirected:=false;
end;
{$endif}

{$ifdef WINDOWS}
function Handler (dw: dword): bool;
begin
 FlushFileBuffers (GetStdHandle(std_output_handle));

 if OutputWasRedirected then
   closefile (Cons);

 result:=false;
end;
{$endif}

procedure WriteC (Value: string);
begin
 if OutputWasRedirected then
   write (Cons, Value)
   else write (Value);
end;

procedure WriteA (Value: string);
begin
 write (Value);
 if OutputWasRedirected then
   write (Cons, Value);
end;

procedure WriteLnC (Value: string);
begin
 if OutputWasRedirected then
   writeln (Cons, Value)
   else writeln (Value);
end;

procedure WriteLnA (Value: string);
begin
 writeln (Value);
 if OutputWasRedirected then
   writeln (Cons, Value);
end;

procedure WriteIfC (Value: string);
begin
 if OutputWasRedirected then
   write (Value);
end;

procedure WriteLnIfC (Value: string);
begin
 if OutputWasRedirected then
   writeln (Value);
end;

initialization
 SetRedirected;
{$ifdef WINDOWS}
//  SetConsoleCtrlHandler (@Handler,true);
{$endif}
 if OutputWasRedirected then begin
   assignfile (Cons, "con");
   rewrite (Cons);
   end;
finalization
{$ifdef WINDOWS}
 if OutputWasRedirected then
   closefile (Cons);
{$endif}
{$warnings off}
end.

(*
program test;
{$apptype console}
uses uPrinter;

begin
 WriteC ("In ");
 WriteLnC ("console");

 WriteA ("In console ");
 WriteLnA ("and in file");

 Write ("In ");
 Writeln ("standart output");

 WriteIfC ("In file ");
 WriteLnIfC ("if redirected");
end.
*)

//  ===========================================

{
 Этот модуль управляет отображением информации о состоянии программы
}
unit uState;

interface

var StateCount: integer = 500;

procedure waNewState (Caption: string);
procedure waAddProgress;
procedure waDone;

implementation
uses SysUtils, DateUtils, uPrinter;

var InState: boolean = false;
   Progress: integer;
   StartTime: TDateTime;

procedure EraseProgress;
var i: integer;
begin
 for i:=1 to 4 do
   writec(#8);
end;

procedure WriteProgress;
var s: string;
begin
 s:="....";
 s[4-(Progress mod 4)]:=" ";
 writec(s);
end;

procedure waNewState (Caption: string);
begin
 if InState then
   waDone;
 InState:=true;
 writea (Caption+" ... ");
 Progress:=0;  
 StartTime:=now;
end;

var AddProgress_staticvar: integer = 0;
procedure waAddProgress;
begin  
 inc (AddProgress_staticvar);
 if AddProgress_staticvar < StateCount then Exit;
 AddProgress_staticvar:=0;

 if MilliSecondsBetween(StartTime,now) > 250 then begin
   inc (Progress);
   EraseProgress;
   WriteProgress;
   StartTime:=now;
   end;
end;

procedure waDone;
begin
 Progress:=0;
 EraseProgress;
 WriteProgress;
 writelna("done");
 InState:=false;
end;

end.


 
MeF Dei Corvi ©   (2006-10-21 16:54) [3]

А что за программа?


 
TUser ©   (2006-10-21 16:55) [4]

Юзинг

waNewState ("Wait, please, mamu vashu");
for  ... do begin
 ...
 waAddProgress;
 end;
waDone;


 
Гарри Поттер ©   (2006-10-21 17:26) [5]

> [2] TUser ©   (21.10.06 16:45)

Спасибо, конечно :) Но это не то.
> [1] Ученик чародея ©   (21.10.06 15:29)
> Просто, стандартно, сердито...

Потому и неохота, что "стандартно и сердито".
-
Лана, сам че-нибудь нарисую с фотошопе.. Хлопну коньяка сотку и нарисую.. :)


 
Ketmar ©   (2006-10-21 17:47) [6]

2TUser: а почему "con", а не "CONOUT$", как полагается? %-)


 
Leonid Troyanovsky ©   (2006-10-21 17:50) [7]


> Гарри Поттер ©   (21.10.06 17:26) [5]


%windir%\clock.avi

--
Regards, LVT.


 
Ученик чародея ©   (2006-10-21 19:01) [8]


> Leonid Troyanovsky ©   (21.10.06 17:50) [7]
>
>
> > Гарри Поттер ©   (21.10.06 17:26) [5]
>
>
> %windir%\clock.avi
>
> --
> Regards, LVT.


В конце БАБАХ-а не хватает...


 
Думкин ©   (2006-10-21 19:23) [9]

TGauge можно вместо TProgressBar.


 
Gero ©   (2006-10-21 19:50) [10]

> [7] Leonid Troyanovsky ©   (21.10.06 17:50)

Никогда, кстати не понимал, что это и где этот файл используется?


 
Percent   (2006-10-21 22:26) [11]

Никогда, кстати не понимал, что это и где этот файл используется?

Значит, еще время не настало...
Но Билл - предусмотрительный парень...


 
Gero ©   (2006-10-21 22:27) [12]

> [11] Percent   (21.10.06 22:26)

LOL :)



Страницы: 1 вся ветка

Форум: "Прочее";
Текущий архив: 2006.11.12;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.48 MB
Время: 0.043 c
9-1138394738
Kaviss
2006-01-27 23:45
2006.11.12
Что посоветуете по редактору ландшафта


15-1161381093
WinSetup
2006-10-21 01:51
2006.11.12
Расскажите мне как это работает


2-1161802535
Батя
2006-10-25 22:55
2006.11.12
как вставить в memo текст


15-1161335350
IMHO
2006-10-20 13:09
2006.11.12
"По образу и подобию своему..."


15-1161381231
learner
2006-10-21 01:53
2006.11.12
Надоело быть Learner, теперь буду Riply :)





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский