VPF::Без формы... - Форум программистов

Maestro

Дата 26.1.2006, 23:07 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 46
Регистрация: 7.9.2005

Репутация: нет
Всего: нет

Как сделать безформенное приложение и использовать в нем компоненты к примеру Timer или Indy?

InfMag

Дата 26.1.2006, 23:12 (ссылка)

(нет голосов)

Загрузка ...

…

Профиль
Группа: Завсегдатай
Сообщений: 1037
Регистрация: 21.11.2004

Репутация: нет
Всего: 4

Модульными средствами помоему
DataModule
Жми кароче New->Other и там это дело ищи, разберешся

bems

Дата 26.1.2006, 23:39 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

Никак. DataModule это формально без формы, но приимущества теряются. И малого размера не получится.

--------------------

Обижено школьников: 8

InfMag

Дата 26.1.2006, 23:44 (ссылка)

(нет голосов)

Загрузка ...

…

Профиль
Группа: Завсегдатай
Сообщений: 1037
Регистрация: 21.11.2004

Репутация: нет
Всего: 4

bems
Ну а как ты еще хочешь безформенное приложение делать?

Poseidon

Дата 26.1.2006, 23:49 (ссылка)

(нет голосов)

Загрузка ...

Delphi developer

Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 53
Всего: 133

Maestro, удаляй все формы из проекта и модуль forms.
Компоненты создавай на Application

--------------------

Если хочешь, что бы что-то работало - используй написанное,
если хочешь что-то понять - пиши сам...

bems

Дата 26.1.2006, 23:52 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88

Цитата(InfMag @ 26.1.2006, 23:44)

Ну а как ты еще хочешь безформенное приложение делать?

Только с модулем windows и все
Добавлено @ 23:54

Цитата(Poseidon @ 26.1.2006, 23:49

)

удаляй все формы из проекта и модуль forms.
Компоненты создавай на Application

а Application разве не в forms объявлен??

--------------------

Обижено школьников: 8

Демо

Дата 27.1.2006, 01:30 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

А зачем для использования Indy нужны формы?

Вот пример выполнения в потоке, делал для сорцов. Здесь Forms не используется.

Код


{
Модуль uGetHTTPThread
Выполнение запроса HTTP GET в отдельном потоке с
возможностью повторного использования.
Ведется учет количества потоков

Требования - установленный Indy10

 (c) Демо

Специально для Sources.ru (2005)

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: String;
begin
  with TGetHTTP.Create do
  begin
    OnComplete := Complete;
    Get('http://www.sources.ru');
  end;
  with TGetHTTP.Create do
  begin
    OnComplete := Complete;
    Get('http://localhost');
  end;

procedure TForm1.Complete(Sender: TGetHTTP; var Action: TActionHTTPThread);
begin
  Memo1.Lines.Add('Complete');
  Memo1.Lines.Add(Sender.Result.RecvStr);
  Action := ahFree;
end;

}
unit uGetHttpThread;

interface

uses
  windows,classes, SysUtils, idHTTP, idLogDebug, idComponent, idGlobal,IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack,  IdIntercept,idException;

var
  ThrList: TThreadList;

type

//Состояние потока
  TStateHTTPThread=(shNone,shReady,shComplete,shWork);
//Действие при обработке OnComplete
  TActionHTTPThread=(ahNone,ahFree);
  TGetHTTP=class;
  TCompleteQuery=procedure(Sender: TGetHTTP; var Action:TActionHTTPThread) of Object;

//Структура, заполняемая в потоке.
  THTTPRec=record
    Query: String;              //Запрос в виде http://url
    ErrorMsg: String;           //Результатт в текстовом виде
    ErrorCode: Integer;         //Результат в числовом виде
    RecvStr: String;            //Принятая строка(полностью с заголовком)
    SendStr: String;            //Отосланная строка
    CountSend: Integer;         //Количество отосланных байт
    CountRcv: Integer;          //Количество принятых байт
    Page: String;               //Возвращенная страница(без заголовка)
  end;

//Собственно, сам поток
  TGetHTTP=class(TThread)
  private
    FH: TidHTTP;
    FL: TidLogDebug;
    FS: TIdIOHandlerStack;
    FTimeOut: Integer;
    FQuery: String;
    FResult: THTTPRec;
    FState: TStateHTTPThread;
    FOnComplete: TCompleteQuery;
    procedure FComplete;
    procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure FLReceive(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    procedure FLSend(ASender: TIdConnectionIntercept;
      var ABuffer: TBytes);
    function GetTimeOut: Integer;
    procedure SetTimeOut(const Value: Integer);

  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Free;
    procedure Release;

    procedure Get(const Query: String);

    property OnComplete: TCompleteQuery read FOnComplete write FOnComplete;
    property Result: THTTPRec read FREsult;
    property State: TStateHTTPThread read FState;
    property TimeOut: Integer read GetTimeOut write SetTimeOut;
  end;

//Получение максимального количества потоков
function GetMaxThreads: Integer;

//Установка максимального количества потоков
procedure SetMaxThreads(aMaxThreads: Integer=10);

//завершение всех потоков и очистка списка
procedure TerminateAllThreads;

//Завершение конкретного потока
procedure ReleaseThread(Thread:TGetHTTP);

//Получение количества потоков в списке
function CheckCountThreads: Integer;

implementation

var
//Максимальное количество потоков - недоступно из других модулей напрямую
  MaxThreads: Integer;

{ TGetHTTP }

constructor TGetHTTP.Create;
begin
  if CheckCountThreads=GetMaxThreads then raise Exception.Create('Can''t create thread. MaxThreads='+IntToStr(MaxThreads));
  inherited Create(True);
  FreeOnTerminate := False;
  FState := shNone;             //Поток еще не готов принять запрос
  with ThrList.LockList do      //Добавляем поток в список
  try
    Add(Self);
  finally
    ThrList.UnlockList;
  end;
  TimeOut := 30000;
  Resume;
end;

destructor TGetHTTP.Destroy;
begin
  FH.Free;
  FS.Free;
  FL.Free;
end;

procedure TGetHTTP.Execute;
begin
  FH := TidHTTP.Create(nil);
  FL := TidLogDebug.Create(nil);
  FS := TIdIOHandlerStack.Create(nil);
  FS.Intercept := FL;
  FH.IOHandler := FS;
  FL.Active := True;
  FH.OnWork := FHWork;
  FL.OnReceive := FLReceive;
  FL.OnSend := FLSend;
  FState := shReady;
  if FQuery='' then Suspend;    //Запрос пустой - засыпаем
  try
    while not Terminated do
    begin
      FState := shWork;           //Поток занят
      FResult.Query := FQuery;
      FResult.ErrorMsg := '';
      FResult.ErrorCode := 0;
      FResult.RecvStr := '';
      FResult.SendStr := '';
      FResult.CountSend := 0;
      FResult.CountRcv := 0;
      FResult.Page := '';
      FQuery := '';

      try
        FH.ReadTimeout := TimeOut;       //Таймаут
        FResult.Page := FH.Get(FResult.Query);
        FResult.ErrorMsg := FH.ResponseText;
        FResult.ErrorCode := FH.ResponseCode;
      except
        on e: Exception do
        begin
          FResult.ErrorMsg := e.Message;
          FResult.ErrorCode := -1;
        end;
      end;
      FState := shComplete;       //Поток закончил выполнение запроса
      Synchronize(FComplete);     //Сообщаем пользователю
      if not Terminated then Suspend;
    end;
  finally
    ReleaseThread(Self);
  end;
end;

procedure TGetHTTP.FComplete;
var
  Action: TActionHTTPThread;
begin
  Action := ahNone;
  if Assigned(FOnComplete) then FOnComplete(Self,Action);
  if Action = ahFree
    then  Terminate;//ReleaseThread(Self)    //Завершаем поток
//    else Suspend;               //Засыпаем снова - до следующего запроса
end;

procedure TGetHTTP.FHWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
//Увеличиваем соответствующий счетчик
  case AWorkMode of
    wmRead: FResult.CountRcv := FResult.CountRcv + AWorkCount;
    wmWrite: FResult.CountSend := FResult.CountSend + AWorkCount;
  end;
end;

procedure TGetHTTP.FLReceive(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: String;
begin
//  Добавляем в буфер полученную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[0],s[1],Length(ABuffer));
  FResult.RecvStr := FResult.RecvStr + s;
end;

procedure TGetHTTP.FLSend(ASender: TIdConnectionIntercept;
  var ABuffer: TBytes);
var
  s: String;
begin
//  Добавляем в буфер отправленную информацию
  SetLength(s,Length(ABuffer));
  Move(ABuffer[1],s[1],Length(ABuffer));
  FResult.SendStr := FResult.SendStr + s;
end;

procedure TGetHTTP.Free;
begin
//заменяем процедуру Free на нашу
  Release;
end;

procedure TGetHTTP.Get(const Query: String);
var
  i: Integer;
begin
//Проверяем, закончена ли предыдущая обработка.
  if (FState=shComplete) or (FState=shWork)
    then raise Exception.Create('Error state thread');

//Если поток еще толтько стартует - ожидаем.
  i := 100;
  while FState<>shReady do
  begin
    Sleep(10);
    //Слишком долго поток не переходит в статус shReady
    if i<0 then raise Exception.Create('Unknown error');
    Dec(i,10);
  end;
  FQuery := Query;
//Будим поток для выполнения запроса
  Resume;
end;

function TGetHTTP.GetTimeOut: Integer;
begin
  Result := InterlockedExchange(FTimeOut,FTimeOut);
end;

procedure TGetHTTP.SetTimeOut(const Value: Integer);
begin
  InterlockedExchange(FTimeOut,Value);
end;

procedure TGetHTTP.Release;
begin
  FreeOnTerminate := True;      //Переводим в состояние автоуничтожения
  Terminate;                    //Взводим флаг Terminated
  Resume;                       //Будим поток для завершения
end;

procedure TerminateAllThreads;
var
  i: Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        TGetHTTP(Items[i]).Release;
      except
      end;
    end;
  finally
    ThrList.UnlockList;
  end;
end;

//Получить максимальное количество потоков.
function GetMaxThreads: Integer;
begin
  Result := InterlockedExchange(MaxThreads,MaxThreads);
end;

//Установить максимальное количество потоков.
procedure SetMaxThreads(aMaxThreads: Integer=10);
var
  CurrValue: Integer;
begin
  CurrValue := InterlockedExchange(MaxThreads,MaxThreads);
  if CurrValue>aMaxThreads then
  InterlockedExchange(MaxThreads,aMaxThreads);
end;

//Получить теккущее количество потоков
function CheckCountThreads: Integer;
begin
  with ThrList.LockList do
  try
    Result := Count;
  finally
    ThrList.UnlockList;
  end;
end;

//Завершить поток
procedure ReleaseThread(Thread:TGetHTTP);
var
  i:Integer;
begin
  with ThrList.LockList do
  try
    for i := 0 to Count-1 do
    begin
      try
        if TGetHTTP(Items[i])=Thread then
        begin
          TGetHTTP(Items[i]).Free;
          Delete(i);
          break;
        end;
      except
      end;
    end;
  finally
    ThrList.UnlockList;
  end;
end;

initialization
  MaxThreads := 10;
  ThrList := TThreadList.Create;
finalization
  TerminateAllThreads;
  ThrList.Free;
end.

Или вот:

Код


program SetTime;
uses
  Windows, SysUtils, IdTime;


var
  CurrTime: TDateTime;
  st: TSystemTime;
  YY,MM,DD,HH,NN,SS,MS: Word;
begin
    try
      with tIdTime.Create(nil) do
      begin
//        Host := 'ntps1-0.uni-erlangen.de';
        Host := '192.168.0.1';
        try
          CurrTime := DateTime;
        except
        end;
        Free;
      end;
    except
      Exit;
    end;
    GetLocalTime(st);
    DecodeDate(CurrTime,YY,MM,DD);
    DecodeTime(CurrTime,HH,NN,SS,MS);
    st.wYear := YY;
    st.wMonth := MM;
    st.wDay := DD;
    st.wHour := HH;
    st.wMinute := NN;
    st.wSecond := SS;
    st.wMilliseconds := MS;
    SetLocalTime(st);
end.

--------------------

Maestro

Дата 27.1.2006, 16:31 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 46
Регистрация: 7.9.2005

Репутация: нет
Всего: нет

...Как без формы посадить Timer сделать вызов события OnTimer?

_hunter

Дата 27.1.2006, 16:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

лепи на форму таймер. назначай ему обработчик.
потом перенеси этот метод в свое приложение и назная его таймеру
someTimer.OnTimer = method;

а создать таймер:
someTimer = TTimer.Create();

--------------------

Tempora mutantur, et nos mutamur in illis...

Maestro

Дата 27.1.2006, 17:14 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 46
Регистрация: 7.9.2005

Репутация: нет
Всего: нет

Код


program test;

uses
  Windows, SysUtils;


begin

end.

Куда вписать метод?

devmstr

Дата 27.1.2006, 17:23 (ссылка)

(нет голосов)

Загрузка ...

Developer

Профиль
Группа: Участник
Сообщений: 879
Регистрация: 28.4.2004
Где: Ukraine

Репутация: 2
Всего: 11

Timer вообще юзай стандартный(Win Api).
CreateTimer и погнал...,если надо, могу кинуть пример.

--------------------

Think different ©Steve Jobs
user posted image

Romikgy

Дата 27.1.2006, 17:30 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Код


program test;    
uses    
  Windows, SysUtils;    
procedure WorkTimer;
begin
//Сюда ложим то что надо
end;
var t1:Ttimer;
begin    
t1:=Ttimer.create();
t1.Interval:=время в мс;
t1.OnTimer:=WorkTimer;
//Ожидание завершения работы приложения
t1.Free;
end.

Только с процедурой для таймера в хелпе посмотри smile

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

Guedda

Дата 27.1.2006, 17:34 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Код


program Test;

uses
  Windows, SysUtils;

var
  SomeTimer : Ttimer;

procedure TimerEnabled(Sender : TObject);
begin
  //здесь пишешь обработчик таймера
end;

begin
  SomeTimer := TTimer.Create(nil);
  SomeTimer.Interval := 1000;
  SomeTimer.OnTimer := TimerEnabled;
  SomeTimer.Enabled := true;
end.

--------------------

Ll 2

Maestro

Дата 27.1.2006, 17:54 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 46
Регистрация: 7.9.2005

Репутация: нет
Всего: нет

Guedda, говорит что не понимет тип метода, как TimerEnabled задикларировать?

Rennigth

Дата 27.1.2006, 18:02 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Guedda Update...

Код


program Test;

uses
  Windows, SysUtils, ExtCtrls, Forms;

var
  SomeTimer : Ttimer;

procedure TimerEnabled(Sender : TObject);
begin
  //здесь пишешь обработчик таймера
end;

begin
  SomeTimer := TTimer.Create(nil);
  SomeTimer.Interval := 1000;
  SomeTimer.OnTimer := TimerEnabled;
  SomeTimer.Enabled := true;
  while not Application.Terminated do
      Application.HandleMessage;
end.

Выход из программы самому делать придеть как-нибудь.
Добавлено @ 18:11
т.е. ошибся: вот рабочий:

Код


unit Unit1;

interface

uses
  sysUtils, Dialogs, ExtCtrls, Controls, Classes;

type

  TSomeTimer = class(TTimer)
  protected
    procedure TimerEnabled(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;


  end;


var
  SomeTimer: TSomeTimer;

implementation

procedure TimerEnabled(Sender: TObject);
begin
  ShowMessage('');
end;


{ TSomeTimer }

constructor TSomeTimer.Create(AOwner: TComponent);
begin
  inherited;
  OnTimer := TimerEnabled;
end;

procedure TSomeTimer.TimerEnabled(Sender: TObject);
begin
  ShowMessage('');
end;

end.

Код


program Project2;

uses
  Windows,
  SysUtils,

  Forms, Classes,
  Unit1 in 'Unit1.pas';

begin
  SomeTimer := TSomeTimer.Create(nil);
  SomeTimer.Enabled := True;




  while not Application.Terminated do
      Application.HandleMessage;
end.

--------------------

(* Honesta mors turpi vita potior *)

Maestro

Дата 27.1.2006, 18:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 46
Регистрация: 7.9.2005

Репутация: нет
Всего: нет

Работает!, но можно как нить без цыкла обойтись, ато загрузка процесса до 90% доходит?

Код


  while not Application.Terminated do
      Application.HandleMessage;

Как ни будь что б работал один таймер?

Guedda

Дата 27.1.2006, 21:20 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Тогда нужно пользоваться WinAPI-функциями и создавать отдельный процесс под таймер.
Для этого необходимо немного почитать инфы.

--------------------

Ll 2

Демо

Дата 28.1.2006, 18:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Цитата(Maestro @ 27.1.2006, 19:41

)

Работает!, но можно как нить без цыкла обойтись, ато загрузка процесса до 90% доходит?

Тебе шашечки ил иехать?
Вообще-то создание таймера не может быть самоцелью, для чего-то же программа предназначена?
Вот вместо цикла программа и должна что-то полезное делать.

Либо ставь конкретно задачу - что тебе нужно.

--------------------

DragonFire

Дата 28.1.2006, 22:28 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 725
Регистрация: 14.8.2005
Где: Москва

Репутация: нет
Всего: 9

Господи, а вообще без всяких апликатионов не пробовали?
Вот прожка кружочки рисует цветные smile

Прикольно

Код


program Paint;

uses
   Windows, Messages;

const
  AppName = 'WinPaint';
  id_Timer = 100; // èäåíòèôèêàòîð òàéìåðà

Var
  Window : HWnd;
  Message : TMsg;
  WindowClass : TWndClass;

function WindowProc (Window : HWnd; Message, WParam : Word;
         LParam : LongInt) : LongInt; stdcall;
Var
    dc : HDC;
    MyPaint : TPaintStruct;
    Brush : hBrush;
Begin
  WindowProc := 0;
  case Message of
   wm_Create  : dc := GetDC(Window);
   wm_Destroy : begin
                KillTimer (Window, id_Timer);
                DeleteDC (dc);
                PostQuitMessage (0);
                Exit;
                end;
   wm_Timer:    InvalidateRect(Window, nil, False);
   wm_Paint:    begin
                dc := BeginPaint (Window, MyPaint);
                Brush := CreateSolidBrush (RGB (random (255), random (255), random (255)));
                SelectObject (dc, Brush); 
                Ellipse (dc, 10, 10, 110, 110);
                DeleteObject (Brush);
                EndPaint (Window, MyPaint);
                ReleaseDC (Window, dc);
                end;
  end; // case
  WindowProc := DefWindowProc (Window, Message, WParam, LParam);
End;


begin
      With WindowClass do
        begin
        Style := cs_DblClks;
        lpfnWndProc := @WindowProc;
        cbClsExtra := 0;
        cbWndExtra := 0;
        hInstance := 0;
        hIcon := LoadIcon (0, idi_Application);
        hCursor := LoadCursor (0, idc_Arrow);
        hbrBackground := GetStockObject (White_Brush);
        lpszMenuName := '';
        lpszClassName := AppName;
        end;
       If RegisterClass (WindowClass) = 0 then
          Halt (255);
       Window := CreateWindow (AppName, 'Òàéìåð',
        ws_OverlappedWindow, 100, 100, 150, 150, 0, 0, HInstance, nil);
       ShowWindow (Window, CmdShow);
       UpdateWindow (Window);
       SetTimer (Window, id_Timer, 200, nil); // Óñòàíîâêà òàéìåðà
       Randomize;
       while GetMessage (Message, 0, 0, 0) do begin
         TranslateMessage (Message);
         DispatchMessage (Message);
        end;
      Halt (Message.wParam);
end.

--------------------

http://dragonfire.cimanu.ru/

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »