Елена Филиппова
дата публикации 16-10-2000 00:00

---

Версия для печати

• Есть текущее значение счетчика;
• При каждой загрузке скрипта оно увеличивается на единицу и формируется GIF-изображение ( то есть рисуются цифры);
• Картинка выводится в выходной поток и отправляется клиенту.

Function ReadCounter : String;
Var   FHandle     ,
      Counter     : Cardinal;
      FileName    : String;
Begin
    Result:= '0';
    // имя файла со значением счетчика
    FileName:='counter.dat';

    Counter:=0;

    Try
	// пытаемся открыть или создать этот файл и читать из него	
      IF NOT FileExists(FileName)
      Then FHandle:=FileCreate(FileName)
      Else Begin
             FHandle:=FileOpen(FileName,fmOpenReadWrite);
             FileRead(FHandle,Counter,SizeOF(Counter));
           End;

      Result:= IntToStr(Counter);
	// увеличиваем счетчик 		  
      Inc(Counter);

	// и пытаемся записать новое значение обратно в файл 		  	  
      FileSeek(FHandle,0,0);
      FileWrite(FHandle,Counter,SizeOF(Counter));
      FileClose(FHandle);
    Except
    End;
   

End;

1. Читаем из файла значение счетчика;
2. Создаем объект TBitmap и пишем, то есть рисуем на его канве текст;
3. Создаем объект TGIFImage и передаем ему изображение, то есть конвертируем в формат GIF сформированную картинку. Это действие необходимо, так как сразу рисовать в формате GIF мы не можем;
4. Создаем объект TMemoryStream и "переливаем" в бинарный поток наше изображение;
5. Передаем этот поток в Response и отправляем его в броузер клиента.
6. Ну и не забываем почистить за собой.

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
Var
   Image      : TGIFImage;
   Stream     : TMemoryStream;
   BMP        : TBitMap;
begin
   Image:=TGIFImage.Create;
   BMP:=TBitMap.Create;
   Stream:=TMemoryStream.Create;

   Try 	   
   	BMP.Width:=100;
   	BMP.Height:=20;

   	BMP.Canvas.TextOut(0,0, ReadCounter);

   	Image.Assign(BMP);
   	Image.SaveToStream(Stream);
   	Stream.Position:=0;
	Try
   		Response.ContentType:='image/gif';

   		Response.ContentStream:=Stream;
   		Response.SendResponse;
   	Except
		Stream.Free;
   	End;
   Finally
   	Image.Free;
   	BMP.Free;   
   End; 

end;

Примечание:

http://localhost/cgi-bin/counter.exe?par1=10&par2=Test& 

property Names[Index: Integer]: string; 
и
property Values[const Name: string]: string; 
соответственно.

//------------------------------------------------------------
//      Получить входящие данные независимо от метода запроса
//
//      Порядок поиска : 1) Из входящего потока (GET )
//                       2) Из полей формы      (POST)
//                       3) Из cookies
//------------------------------------------------------------
Function GetRequest( Request : TWebRequest ; Value : String) : String;
Begin
    Result:=Request.QueryFields.Values[Value];

    Result:=IsEmpty( Result , Request.ContentFields.Values[Value]);
    Result:=IsEmpty( Result , Request.CookieFields.Values[Value]);

    Result:=Trim(Result);
End;
//------------------------------------------------------------
Function IsEmpty( Value , Empty : String): String;
Begin
    IF Trim(Value) = '' Then Value:=Empty;
    Result:=Value;
End;
//------------------------------------------------------------

   Text:=GetRequest(Request,'Color');
   IF NOT IdentToColor( Text , Color )  Then Color:=clWhite;

   No:=GetNumeric(GetRequest(Request , 'NoCount');
   IF No = 0 Then No:=10;

// Устанавливаем параметры шрифта, в том числе полученный цвет 
BMP.Canvas.Font.Color:=TColor(Color);
BMP.Canvas.Font.Size:=12;
BMP.Canvas.Font.Name:='Arial';
BMP.Canvas.Font.Style:=BMP.Canvas.Font.Style + [fsBold];

// Рассчитываем размер картинки исходя из выбранного шрифта
// ну и прибавляем по пикселю со всех сторон, для красоты :о)  
CharW:=BMP.Canvas.TextWidth('0');
BMP.Width:=No*CharW + 2;
BMP.Height:=BMP.Canvas.TextHeight('0') + 2;

// Готовим фон счетчика и рисуем его!
BMP.Canvas.Brush.Color:=ClBlack;
BMP.Canvas.FillRect(RECT(0,0 , BMP.Width,BMP.Height));
BMP.Canvas.TextOut(1 ,1 , ReadCounter(No , FileName));

Елена Филиппова
Специально для Королевства "Delphi"

• Файлы проекта + exe (234 K) обновление от 11/3/2005 7:47:00 AM
• Файлы проекта (12 K) обновление от 11/3/2005 7:47:00 AM