Текст вопроса:

Здравствуйте, эксперты! Вопрос таков: Подскажите как можно инвертировать, вращать, устанавливать фоновый цвет изображения, загруженного в TImage?

Вопрос задал участник: Ситников Константин Евгеньевич
Дата и время отправки вопроса: 07.05.2006, 19:24
Всего ответов: 5
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Степанов Игорь Николаевич (статус: 6-ой класс), 07.05.2006, 20:31]:

Посмотри, возможно поможет:

Приложение:

procedure RotateRight(BitMap: tImage); var FirstC, LastC, c, r: integer; procedure FixPixels(c, r: integer); var SavePix, SavePix2: tColor; i, NewC, NewR: integer; begin SavePix := Bitmap.Canvas.Pixels[c, r]; for i := 1 to 4 do begin newc := BitMap.Height - r + 1; newr := c; SavePix2 := BitMap.Canvas.Pixels[newc, newr]; Bitmap.Canvas.Pixels[newc, newr] := SavePix; SavePix := SavePix2; c := Newc; r := NewR; end; end; begin if BitMap.Width <> BitMap.Height then exit; BitMap.Visible := false; with Bitmap.Canvas do begin firstc := 0; lastc := BitMap.Width; for r := 0 to BitMap.Height div 2 do begin for c := firstc to lastc do begin FixPixels(c, r); end; inc(FirstC); Dec(LastC); end; end; BitMap.Visible := true; end;

2. [Отвечает: Матвеев Игорь Владимирович (статус: Практикант), 08.05.2006, 00:28]:

На счет вращения и инверсии все понятно - см. приложение, но что Вы имели ввиду под установкой фонового цвета? Может Вам нужно просто залить какую-то область нужным цветом - это функция FloodFill:
Canvas.FloodFill(10, 10, clBlack, fsBorder);

Приложение:

procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor); var x, y, W, H, v1, v2: Integer; Dest, Src: pRGB; VertArray: array of pByteArray; Bmp: TBitmap; procedure SinCos(AngleRad: Double; var ASin, ACos: Double); begin ASin := Sin(AngleRad); ACos := Cos(AngleRad); end; function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double): TRectList; var DX, DY: Integer; SinAng, CosAng: Double; function RotPoint(PX, PY: Integer): TPoint; begin DX := PX - Center.x; DY := PY - Center.y; Result.x := Center.x + Round(DX * CosAng - DY * SinAng); Result.y := Center.y + Round(DX * SinAng + DY * CosAng); end; begin SinCos(Angle * (Pi / 180), SinAng, CosAng); Result[1] := RotPoint(Rect.Left, Rect.Top); Result[2] := RotPoint(Rect.Right, Rect.Top); Result[3] := RotPoint(Rect.Right, Rect.Bottom); Result[4] := RotPoint(Rect.Left, Rect.Bottom); end; function Min(A, B: Integer): Integer; begin if A < B then Result := A else Result := B; end; function Max(A, B: Integer): Integer; begin if A > B then Result := A else Result := B; end; function GetRLLimit(const RL: TRectList): TRect; begin Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x)); Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y)); Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x)); Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y)); end; procedure Rotate; var x, y, xr, yr, yp: Integer; ACos, ASin: Double; Lim: TRect; begin W := Bmp.Width; H := Bmp.Height; SinCos(-Angle * Pi / 180, ASin, ACos); Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0), Angle)); Bitmap.Width := Lim.Right - Lim.Left; Bitmap.Height := Lim.Bottom - Lim.Top; Bitmap.Canvas.Brush.Color := BackColor; Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height)); for y := 0 to Bitmap.Height - 1 do begin Dest := Bitmap.ScanLine[y]; yp := y + Lim.Top; for x := 0 to Bitmap.Width - 1 do begin xr := Round(((x + Lim.Left) * ACos) - (yp * ASin)); yr := Round(((x + Lim.Left) * ASin) + (yp * ACos)); if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then begin Src := Bmp.ScanLine[yr]; Inc(Src, xr); Dest^ := Src^; end; Inc(Dest); end; end; end; begin Bitmap.PixelFormat := pf24Bit; Bmp := TBitmap.Create; try Bmp.Assign(Bitmap); W := Bitmap.Width - 1; H := Bitmap.Height - 1; if Frac(Angle) <> 0.0 then Rotate else case Trunc(Angle) of -360, 0, 360, 720: Exit; 90, 270: begin Bitmap.Width := H + 1; Bitmap.Height := W + 1; SetLength(VertArray, H + 1); v1 := 0; v2 := 0; if Angle = 90.0 then v1 := H else v2 := W; for y := 0 to H do VertArray[y] := Bmp.ScanLine[Abs(v1 - y)]; for x := 0 to W do begin Dest := Bitmap.ScanLine[x]; for y := 0 to H do begin v1 := Abs(v2 - x) * 3; with Dest^ do begin B := VertArray[y, v1]; G := VertArray[y, v1 + 1]; R := VertArray[y, v1 + 2]; end; Inc(Dest); end; end end; 180: begin for y := 0 to H do begin Dest := Bitmap.ScanLine[y]; Src := Bmp.ScanLine[H - y]; Inc(Src, W); for x := 0 to W do begin Dest^ := Src^; Dec(Src); Inc(Dest); end; end; end; else Rotate; end; finally Bmp.Free; end; end; procedure InvertBitmap(Bitmap: TBitmap); var x, y : Integer; Dest : pRGB; begin Bitmap.PixelFormat := pf24Bit; for y := 0 to Bitmap.Height - 1 do begin Dest := Bitmap.ScanLine[y]; for x := 0 to Bitmap.Width - 1 do begin with Dest^ do begin R := not R; G := not G; B := not B; end; Inc(Dest); end; end; end;

3. [Отвечает: bruder (статус: 4-ый класс), 08.05.2006, 15:40]:

Здравствуйте, Ситников Константин Евгеньевич!
Инвертировать - код в приложении. Удачи!

Приложение:

function InvertBitmap(MyBitmap: TBitmap): TBitmap; var x, y: Integer; ByteArray: PByteArray; begin MyBitmap.PixelFormat := pf24Bit; for y := 0 to MyBitmap.Height - 1 do begin ByteArray := MyBitmap.ScanLine[y]; for x := 0 to MyBitmap.Width * 3 - 1 do begin ByteArray[x] := 255 - ByteArray[x]; end; end; Result := MyBitmap; end; Example: procedure TForm1.Button1Click(Sender: TObject); begin Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap); Image1.Refresh; end; Во-вторых, вращение изображения на заданный угол: procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor); type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB; pByteArray = ^TByteArray; TByteArray = array[0..32767] of Byte; TRectList = array[1..4] of TPoint; var x, y, W, H, v1, v2: Integer; Dest, Src: pRGB; VertArray: array of pByteArray; Bmp: TBitmap; procedure SinCos(AngleRad: Double; var ASin, ACos: Double); begin ASin := Sin(AngleRad); ACos := Cos(AngleRad); end; function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double): TRectList; var DX, DY: Integer; SinAng, CosAng: Double; function RotPoint(PX, PY: Integer): TPoint; begin DX := PX - Center.x; DY := PY - Center.y; Result.x := Center.x + Round(DX * CosAng - DY * SinAng); Result.y := Center.y + Round(DX * SinAng + DY * CosAng); end; begin SinCos(Angle * (Pi / 180), SinAng, CosAng); Result[1] := RotPoint(Rect.Left, Rect.Top); Result[2] := RotPoint(Rect.Right, Rect.Top); Result[3] := RotPoint(Rect.Right, Rect.Bottom); Result[4] := RotPoint(Rect.Left, Rect.Bottom); end; function Min(A, B: Integer): Integer; begin if A < B then Result := A else Result := B; end; function Max(A, B: Integer): Integer; begin if A > B then Result := A else Result := B; end; function GetRLLimit(const RL: TRectList): TRect; begin Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x)); Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y)); Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x)); Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y)); end; procedure Rotate; var x, y, xr, yr, yp: Integer; ACos, ASin: Double; Lim: TRect; begin W := Bmp.Width; H := Bmp.Height; SinCos(-Angle * Pi / 180, ASin, ACos); Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0), Angle)); Bitmap.Width := Lim.Right - Lim.Left; Bitmap.Height := Lim.Bottom - Lim.Top; Bitmap.Canvas.Brush.Color := BackColor; Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height)); for y := 0 to Bitmap.Height - 1 do begin Dest := Bitmap.ScanLine[y]; yp := y + Lim.Top; for x := 0 to Bitmap.Width - 1 do begin xr := Round(((x + Lim.Left) * ACos) - (yp * ASin)); yr := Round(((x + Lim.Left) * ASin) + (yp * ACos)); if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then begin Src := Bmp.ScanLine[yr]; Inc(Src, xr); Dest^ := Src^; end; Inc(Dest); end; end; end; begin Bitmap.PixelFormat := pf24Bit; Bmp := TBitmap.Create; try Bmp.Assign(Bitmap); W := Bitmap.Width - 1; H := Bitmap.Height - 1; if Frac(Angle) <> 0.0 then Rotate else case Trunc(Angle) of -360, 0, 360, 720: Exit; 90, 270: begin Bitmap.Width := H + 1; Bitmap.Height := W + 1; SetLength(VertArray, H + 1); v1 := 0; v2 := 0; if Angle = 90.0 then v1 := H else v2 := W; for y := 0 to H do VertArray[y] := Bmp.ScanLine[Abs(v1 - y)]; for x := 0 to W do begin Dest := Bitmap.ScanLine[x]; for y := 0 to H do begin v1 := Abs(v2 - x) * 3; with Dest^ do begin B := VertArray[y, v1]; G := VertArray[y, v1 + 1]; R := VertArray[y, v1 + 2]; end; Inc(Dest); end; end end; 180: begin for y := 0 to H do begin Dest := Bitmap.ScanLine[y]; Src := Bmp.ScanLine[H - y]; Inc(Src, W); for x := 0 to W do begin Dest^ := Src^; Dec(Src); Inc(Dest); end; end; end; else Rotate; end; finally Bmp.Free; end; end; Example: procedure TForm1.Button1Click(Sender: TObject); begin RotateBitmap(Image1.Picture.Bitmap, 17.23, clWhite); end;

4. [Отвечает: Zeon . (статус: 8-ой класс), 09.05.2006, 19:20]:

Для вращения: (см. приложение)

А для заливки одним цветом лучше использовать:

procedureTForm1.Button1Click(Sender: TObject);
begin
PatBlt(Form1.Canvas.Handle,
0,
0,
Form1.ClientWidth,
Form1.ClientHeight,
WHITENESS);
end;

побыстрее работает.

Приложение:

Const PixelMax = 32768; Type pPixelArray = ^TPixelArray; TPixelArray = Array[0..PixelMax-1] Of TRGBTriple; Procedure RotateBitmap_ads( SourceBitmap : TBitmap; out DestBitmap : TBitmap; Center : TPoint; Angle : Double); Var cosRadians : Double; inX : Integer; inXOriginal : Integer; inXPrime : Integer; inXPrimeRotated : Integer; inY : Integer; inYOriginal : Integer; inYPrime : Integer; inYPrimeRotated : Integer; OriginalRow : pPixelArray; Radians : Double; RotatedRow : pPixelArray; sinRadians : Double; begin DestBitmap.Width := SourceBitmap.Width; DestBitmap.Height := SourceBitmap.Height; DestBitmap.PixelFormat := pf24bit; Radians := -(Angle) * PI / 180; sinRadians := Sin(Radians); cosRadians := Cos(Radians); For inX := DestBitmap.Height-1 Downto 0 Do Begin RotatedRow := DestBitmap.Scanline[inX]; inXPrime := 2*(inX - Center.y) + 1; For inY := DestBitmap.Width-1 Downto 0 Do Begin inYPrime := 2*(inY - Center.x) + 1; inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians); inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians); inYOriginal := (inYPrimeRotated - 1) Div 2 + Center.x; inXOriginal := (inXPrimeRotated - 1) Div 2 + Center.y; If (inYOriginal >= 0) And (inYOriginal <= SourceBitmap.Width-1) And (inXOriginal >= 0) And (inXOriginal <= SourceBitmap.Height-1) Then Begin OriginalRow := SourceBitmap.Scanline[inXOriginal]; RotatedRow[inY] := OriginalRow[inYOriginal] End Else Begin RotatedRow[inY].rgbtBlue := 255; RotatedRow[inY].rgbtGreen := 0; RotatedRow[inY].rgbtRed := 0 End; End; End; End; {Usage:} procedure TForm1.Button1Click(Sender: TObject); Var Center : TPoint; Bitmap : TBitmap; begin Bitmap := TBitmap.Create; Try Center.y := (Image.Height div 2)+20; Center.x := (Image.Width div 2)+0; RotateBitmap_ads( Image.Picture.Bitmap, Bitmap, Center, Angle); Angle := Angle + 15; Image2.Picture.Bitmap.Assign(Bitmap); Finally Bitmap.Free; End; end;

5. [Отвечает: Вадим К (статус: Практикант), 10.05.2006, 12:22]:

В обычном изображении фоновый цвет никак не отличается от всех остальных. Определить его можно только "зрительно". Причём в разных людей это может быть разный цвет. К примеру, возмём изображение флага. Где там фон? (При условии, что всё изображение занимает флаг).
А теперь ответ На вопрос, как изменить фон.
Изменить фон - значит заменить пиксели с цветом, который мы признали фоном на новый цвет.
Компонент TImage, если ему выставить свойство Transparent, прозрачным считает левый нижний пиксель.

Текст вопроса:

Здраствуйте, подскажите пожалуйста, как с помощью Delphi создать физическую связь (не в коде) 1:М (Master/Detail)между 2-мя таблицами Paradox. Связь реализуется средствами Paradox, т.е. появляются файлы с расширением .VAL, которые отвечают за функционирование связи. Такую связь можно создать в утилите Database Desktop в разделе Referential Integrity при редактировании структуры таблицы. Как решить эту проблему средствами Delphi? (Необходимо сгенерировать пустую базу данных с таблицами и связями)

Вопрос задал участник: Мохов К. Н.
Дата и время отправки вопроса: 08.05.2006, 00:32
Всего ответов: 0
Страница данного вопроса >>

Ответы на данный вопрос:

К сожалению, ответов на данный вопрос не поступило...

Текст вопроса:

Здравствуйте. У себя в отделе мы хотели в своём комплексе использовать технологию MSMQ для передачи данных. Программируем на Delphi 5. Можно ли кто нибудь помочь небольшим работающим примером для освоения этой технологии. Буду вам за это очень благодарен.

Вопрос задал участник: Хорт А.М.
Дата и время отправки вопроса: 08.05.2006, 09:09
Всего ответов: 0
Страница данного вопроса >>

Ответы на данный вопрос:

К сожалению, ответов на данный вопрос не поступило...

Текст вопроса:

Уважаемые эксперты, может кто - то сталкивался с проблемой пойска файлов в скрытых папках? А точнее сначала необходимо найти скрытые папки, а затем осуществить в них поиск файлов! Использую рекурсивный поиск -

Приложение:

... procedure TForm1.FindFiles(Path:string); var FSearchRec, DsearchRec : TSearchRec; FindResult : integer; function IsDir(DirName:string):boolean; begin Result := (DirName = '.') or (DirName = '..'); end; begin Path := GetDirectoryName(Path); FindResult := FindFirst(Path+FileName,$66,FSearchRec);//$66=faAnyFile+faArchive+faHidden+faSysfile+faReadOnly Application.ProcessMessages; try while Findresult = 0 do begin Listbox1.Items.Add(LowerCase(Path+FSearchRec.Name)); FindResult := FindNext(FSearchRec); end; FindResult := FindFirst(Path+'*.*',faDirectory, DSearchRec); while FindResult = 0 do begin if ((DSearchRec.Attr and faDirectory) = faDirectory) and not IsDir(DSearchRec.Name) then FindFiles(Path+DSearchRec.Name); FindResult := FindNext(DSearchRec); end; finally FindClose(FSearchRec); end; end; ...

Вопрос задал участник: West
Дата и время отправки вопроса: 09.05.2006, 01:07
Всего ответов: 2
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Dron (статус: Специалист), 09.05.2006, 08:52]:

Предлагаю немного другой способ поиска. См. код в приложении. Он находит как скрытые файлы, так и скрытые каталоги. В Path задаётся путь для поиска (обязательно со слешем на конце), а в Mask - шаблон поиска. В данном случае будут найдены все файлы без исключения.
Если в качестве каталога для поиска указать скрытый каталог, то и в этом случае программа его просканирует.

Приложение:

procedure TForm1.Button1Click(Sender: TObject); Var DirInfo: TSearchRec; R: Integer; Path,Mask: String; begin Path:='C:\'; Mask:='*.*'; R:=FindFirst(Path+Mask,FaAnyfile,DirInfo); While (R = 0) Do Begin if ((DirInfo.Attr and FaDirectory <> FaDirectory) and (DirInfo.Attr and FaVolumeId <> FaVolumeID)) then ListBox1.Items.Add(Path+DirInfo.Name); R:=FindNext(DirInfo); End; SysUtils.FindClose(DirInfo); end;

Оценка за ответ: 4.

2. [Отвечает: Вадим К (статус: Практикант), 10.05.2006, 12:36]:

Проблема скорее всего здесь.
faAnyFile+faHidden
Первое указывает любой файл, второе - скрытый. Первое уже включает второе+нескрытые файлы.
Наиболее простой способ - создать две процедуры, одна будет искать только скрытые папки и если нашла, то запускать другую процедуру, которая уже производит поиск файлов в заданой папке.
Можно конечно и одной процедурой обойтись и розрулить всё за счёт if'ов, но мороки будет много.

Оценка за ответ: 3.

Текст вопроса:

При перемещении одной формы нужно чтобы вторая перемещалась вместе с ней.

Вопрос задал участник: bruder
Дата и время отправки вопроса: 11.05.2006, 12:34
Всего ответов: 4
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Вадим К (статус: Практикант), 11.05.2006, 13:40]:

Для того, что бы отловить перемещение формы, необходимо перехватывать событие WM_MOVE. В обработчике просто запоминаем новые координаты, стравниваем со старыми, рассчитываем новые координаты для второй формы.

Приложение:

... type TfrmMain = class(TForm) private procedure OnMove(var Msg: TWMMove); message WM_MOVE; end; ... procedure TfrmMain.OnMove(var Msg: TWMMove); begin inherited; ... end; ...

Оценка за ответ: 4.
Комментарий: В следующий раз не ленись и пиши исходник полностью. Я это и сам знаю, что нужно обрабатывать WM_MOVE. Сама проблема в координатах... Авансом тебе 4! :P

2. [Отвечает: Матвеев Игорь Владимирович (статус: Практикант), 12.05.2006, 12:43]:

Вы должны обрабатывать сообщение WM_MOVE формы, оно происходит при изменении положения формы.

Приложение:

Объявление обработчика: TForm1 = class(TForm) private { Private declarations } public { Public declarations } procedure WMMove(var Message: TMessage); message WM_MOVE; end; Обработка сообщений: procedure TForm1.WMMove(var Message: TMessage); begin // Нужно следить, чтобы форма существовала if Form2 = nil then Exit; Form2.Left := Left+Width; Form2.Top := Top; end;

Оценка за ответ: 5.
Комментарий: Ну это так, "отписка". Главная цель достигнута - перемещение. А как же быть, если надо, чтобы вторая форма не сбоку плелась, а снизу? (и с других краёв и вообще не с краёв...) А вообще тема такая: вторая форма липнет к первой и при перемещении первой вторая, оставаясь прилипшей, движется за первой. Липкость уже готова, а вот с перемещением не очень... Получается так, что при резком перемещении вторая форма отлипляется и уже не перемещается :)

3. [Отвечает: Zeon . (статус: 8-ой класс), 12.05.2006, 17:39]:

Когда-то я делал нечто подобное.
Кинул на форму таймер(стандартный компонент) и в его основном событии писал нечто вроде:

if Form2.Left > (Form1.Left + Form1.Width + 1) then Form2.Left := Form2.Left - 1;

Тоже самое для движения на право, вверх и вниз. Посчитаешь сам. Я надеюсь, идея ясна.

Интервал таймера ставишь по вкусу. Таким образом, вторая форма красиво, плавно догоняет первую и прилипает к ней.

Оценка за ответ: 5.
Комментарий: Напрягает только фраза : "Посчитаешь сам." ;) Эт не есть гуд! Ну в общем с таймером - оригинально...

4. [Отвечает: mvp (статус: Студент), 18.05.2006, 12:33]:

Форма два прилипает к форме 1 справа и снизу, при движении формы. По исходникам можете доделать и до прилипания слева и
сверху.

Приложение:

Project1.dpr: program Project1; uses Forms, Unit1 in 'Unit1.pas' {Form1}, Unit2 in 'Unit2.pas' {Form2}; {$R *.res} begin Application.Initialize; Application.CreateForm(TForm2, Form2); Application.CreateForm(TForm1, Form1); Application.Run; end. Unit1.pas unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormMove(var Msg : TWMMove); message WM_MOVe; private lastx, lastY : integer; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation uses Unit2; {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin lastx := Left; lastY := Top; show end; //------------------------------------------------------------------------------ procedure TForm1.FormMove; var j : ^Rpos; begin inherited; new(j); j^.lastx := lastx; j^.lasty := lastY; j^.x := Left; j^.y := Top; j^.width := Width; j^.heigh := Height; postmessage(form2.Handle, wm_user + 1, 0, integer(j)); lastx := left; lasty := top; end; //------------------------------------------------------------------------------ end. Unit2.pas unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type RPos = record lastx, lasty, x, y, width, heigh : integer end; TForm2 = class(TForm) private procedure FormMove(var Msg : TMessage); message wm_user + 1; { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation procedure Tform2.FormMove; var j : ^RPos; begin j := pointer(msg.LParam); if abs(j^.lastx + j^.width - self.Left) < 5 then begin self.left := j^.x + j^.width;//self.left + j^.x - j^.lastx; self.top := self.top + j^.y - j^.lasty end else if abs(j^.lasty + j^.heigh - self.top) < 5 then begin self.left := self.left + j^.x - j^.lastx; self.top := j^.y + j^.heigh;// self.top + j^.y - j^.lasty end; dispose(j) end; {$R *.dfm} end.

Текст вопроса:

Уважаемые эксперты! Подскажите, пожалуйста, как узнать, установлен ли в системе хотя бы один принтер? Заранее благодарю за ответ.

Вопрос задал участник: Sunshine
Дата и время отправки вопроса: 11.05.2006, 15:39
Всего ответов: 3
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: bruder (статус: 4-ый класс), 11.05.2006, 17:49]:

Есть много способов. Вот один из них - с помощью реестра. Кинь на форму кнопку и memo. В событие кнопки OnClick пиши код приложенный к ответу.

Приложение:

procedure TForm1.Button1Click(Sender: TObject); var m: TRegistry; i: integer; l: TstringList; s: string; begin m := TRegistry.Create; l := TStringList.Create; s := '\System\CurrentControlSet\Control\Print\Printers'; m.RootKey := HKEY_LOCAL_MACHINE; m.OpenKey(s, false); m.GetKeyNames(l); // получаем список принтеров m.CloseKey; Memo1.Lines.Clear; for i := 0 to l.Count - 1 do begin m.OpenKey(s + '\' + l[i], false); // Здесь, ради теста, можно сделать проверку на наличие нужного имени драйвера // if m.ReadString('Printer Driver') = 'my printer driver' then .. // добавляем имя принтера в список Memo1.Lines.Add(m.ReadString('Name')); m.CloseKey; end; m.Free; l.Free; end;

Оценка за ответ: 5.

2. [Отвечает: Ершов Денис (статус: Студент), 13.05.2006, 00:56]:

Самое простое что приходит в голову подключить к проекту модуль Printers. После этого программе станет доступно свойство Printer.Printers:TStrings - список установленных в системе принтеров.

Оценка за ответ: 5.
Комментарий: Коротко и удобно!

3. [Отвечает: West (статус: 1-ый класс), 14.05.2006, 00:03]:

Мне известно два способа, один из них осветил bruder, второй:

Приложение:

// uses printers procedure TForm1.Button1Click(Sender: TObject); var i : integer; begin ListBox1.Items.Clear; for i := 0 to Printer.Printers.Count-1 do ListBox1.items.Add(Printer.Printers.Strings[i]); end;

Оценка за ответ: 3.
Комментарий: Во-первых, вы повторили ответ Ершова Дениса; во-вторых, перебор значений Printers делать не нужно - это ведь уже TStrings.

Текст вопроса:

Подскажите, плз, компонент (на torry.net ничего подходящего не нашёл), который бы позволял строить графики на основе ФИНАНСОВЫХ баров и/или свечей. Бар и свеча характеризуются 4 значениями: открытие (open), закрытие (close), максимум (high), минимум (min). Пример свечи: http://it-trade.ru/show_img.asp?id=7659 График из свечей: http://it-trade.ru/show_img.asp?id=7660 Пример бара: http://it-trade.ru/show_img.asp?id=7661 Пример графика из баров: http://it-trade.ru/show_img.asp?id=7663 (в зависимости от того, что больше - open или close, бар раскрашивается в разный цвет). P. S. Денег за компоненту давать не буду, поэтому желательно шароварную или бесплатную. Нужна для диплома, да и то - больше для красоты :) Спасибо

Вопрос задал участник: mvp
Дата и время отправки вопроса: 11.05.2006, 18:30
Всего ответов: 0
Страница данного вопроса >>

Ответы на данный вопрос:

К сожалению, ответов на данный вопрос не поступило...

Текст вопроса:

Здравствуйте! Поясните пожалуйста принцип работы с ftp в Delphi... Интересует закачка и скачка файлов Заранее спасибо!

Вопрос задал участник: Ситников К.Е.
Дата и время отправки вопроса: 12.05.2006, 16:13
Всего ответов: 1
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Dron (статус: Специалист), 12.05.2006, 16:27]:

Работать с FTP удобно через компонент TidFTP (Indy-компонент, вкладка Indy Clients). В Host прописывается имя хоста (или IP-адрес соответственно), в Port - порт для соединения (21 по умолчанию), в Username и Password логин и пароль соответственно. Далее программная часть. Сначала соединяемся: IdFTP1.Connect(True); Загрузить файл на сервер можно с помощью функции Put('имя_локального_файла','имя_файла_на_сервере'). Аналогично можно загрузить файл с сервера на компьютер: Get('файл_на_сервере','файл_для_сохранения'). После завершения работы нужно разъединиться: IdFTP1.Disconnect; Кроме того, у этого компонента большое количество возможностей. Удачи!

Оценка за ответ: 5.

Текст вопроса:

Здравствуйте, эсперты. Я использую компонент TJvDBGrid из библиотеки Jedi. Меня интересует каким образом можно отобразить в сетке текст из поля типа TMemoField. Используемая база данных Access. Буду благодарен за любую помощь.

Вопрос задал участник: Федоров Роман Сергеевич
Дата и время отправки вопроса: 14.05.2006, 18:50
Всего ответов: 0
Страница данного вопроса >>

Ответы на данный вопрос:

К сожалению, ответов на данный вопрос не поступило...

Текст вопроса:

Подскажите пожалуйста универсальную библиотеку для распаковки архивов (разных типов - zip, rar, cab, arj и т.д.). Кроме ZipTV - с ней не понятно - не всегда правильно распаковывает, неправильно работает с русской кодировкай. Желательно бесплатную.

Вопрос задал участник: Матвеев Игорь Владимирович
Дата и время отправки вопроса: 15.05.2006, 15:04
Всего ответов: 1
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: bruder (статус: 4-ый класс), 15.05.2006, 16:45]:

Ну канешна... универсальный, бесплатный, русский, да ещё с исходниками, да ещё без глюков и чтоб работал :)) НЕТ такого в природе ;)

ZIP Master
Бесплатный компонент ZIP Master - паковщик/pаспаковщик ZIP. Очень
удобный интеpфейс, фоpмат PkZip v2.04g. Не поддеpживает некотоpые сеpвисные
возможности типа шифpовки, pезки аpхива на кусочки - а кого это волнует ?
Зато дает возможность отследить progress для каждого файла. Скачал,
кажется, с www.delphiexchange.com.

http://www.aidaim.com - дают много платного и бесплатный ZipForge. Cжимает похуже WinZip'ов и WinRar'ов, но пользоваться легко и возможностей немало.

http://aravilsoft.tripod.com/ - компоненты для работы с cab-файлами. cabinet.dll в любой винде есть, с собой таскать ненадо. Вроде все легально - лицензию в мелкософт получать не надо Минус - жмет слабо.

Вот всё чё нашёл (время мало), если чё получше найду, дам знать...

Оценка за ответ: 2.
Комментарий: Я же говорю - мне нужна библиотека для универсальной обработки архивов разных форматов. Наверное все-таки прийдется остановиться на ZipTV.

Текст вопроса:

У меня такой вопрос: допустим у меня есть некий фаил "C:\index.html", как мне написать такую прогу, чтобы она во время запуска открывала этот фаил и показывала его (как браузер)?

Вопрос задал участник: Жучков С. В.
Дата и время отправки вопроса: 16.05.2006, 14:12
Всего ответов: 2
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Dron (статус: Специалист), 16.05.2006, 15:31]:

Всё просто. Помещаете на форму компонент TWebBrowser (страница Internet) и дальше программно загружаете в него нужную страницу:
WebBrowser1.Navigate('C:\index.html');

Оценка за ответ: 5.
Комментарий: Спасибо

2. [Отвечает: Darya Ermakova (статус: Специалист), 18.05.2006, 16:10]:

Для этого на закладке Internet есть компонент TWebBrowser. Нужно только поставить его на форму и на создание формы задать в методе Navigate адрес документа (можно и интернетовский).
Для вашего примера:
WebBrowser1.Navigate(C:\index.html');

Оценка за ответ: 5.

Текст вопроса:

Ещё один вопрос: как на форме сделать ссылку на мыло или адрес в инете (то есть при нажатии на Deeetyru@xasder.ru или на www.feerut.sk открывалась соответственно почтовая программа или браузер), причём адресс в браузере или поле "Кому" было заполнено этим мылом или адресом?

Вопрос задал участник: Жучков С. В.
Дата и время отправки вопроса: 16.05.2006, 14:15
Всего ответов: 3
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Dron (статус: Специалист), 16.05.2006, 15:34]:

Пропишите вот такой обработчик:
ShellExecute(0,'open',PChar('mailto:Deeetyru@xasder.ru'),'','',SW_SHOWNORMAL);
Или такой соответственно:
ShellExecute(0,'open',PChar('http://www.feerut.sk'),'','',SW_SHOWNORMAL);
Не забудьте добавить в uses модуль ShellAPI.

Оценка за ответ: 5.
Комментарий: Единственный кто упомянул что нужно прописать в uses модуль ShellAPI.

2. [Отвечает: Darya Ermakova (статус: Специалист), 16.05.2006, 16:12]:

Все это делает функция ShellExecute. Как видно в примере, адрес берем из Edit-а, почтовый адрес определяем наличием символа @ и добавляем к нему 'mailto:' для запуска почтовой программы, иначе запускается браузер.

Приложение:

procedure TForm1.Button1Click(Sender: TObject); var s: string; num: integer; begin s:=Edit1.Text; num:=Pos('@',s); if num <> 0 then s:='mailto:'+s; ShellExecute(0,'open', PChar(s),'', nil, SW_SHOWNORMAL); end;

Оценка за ответ: 4.
Комментарий: нет упоминания о добавлении в uses модуля ShellAPI.

3. [Отвечает: bruder (статус: 4-ый класс), 16.05.2006, 18:01]:

Здравствуйте Жучков С. В.!
Я бы хотел дополнить ответы экспертов, думаю, это Вам будет полезно. В приведённом коде показан пример отправки письма с заполненой темой и текстом сообщения.
Используййте %0d для символа перевода строки (LF), %20 для пробела.
Список возможных параметров:
CC=Carbon copy (дополнительные получатели)
BCC=Blind carbon copy (дополнительные получатели, адреса которых не показываются остальным получателям)
SUBJECT=Subject text (тема)
BODY=Body text (текст)

Приложение:

ShellExecute(Handle, 'open', 'mailto:Deeetyru@xasder.ru?subject=Тут_ТЕМА!&body=Здравствуйте.%0dЯ%20Надеюсь%20это%20Вам%20пригодиться.', nil, nil,SW_SHOWNORMAL);

Оценка за ответ: 5.
Комментарий: описаны дополнительные функции типа заполнения поле тема т.д., хотя нет упоминания о добавлении в uses модуля ShellAPI.

Текст вопроса:

Добрый день! По ходу изучения компонента IdPOP3 (вкладка Indy Clients) возник вопрос: можно ли получить тему письма и адрес отправителя не скачивая его (письмо) на комп? И как получить размер письма?

Вопрос задал участник: Жучков С. В.
Дата и время отправки вопроса: 17.05.2006, 14:58
Всего ответов: 1
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Евгений Козаченко (статус: 2-ой класс), 17.05.2006, 15:23]:

Конечно можно!
Соединяемся с сервером, потом
- для получения темы и отправителя:
[b]IdPOP31.RetrieveHeader(k,idmessage1)[/b], [i]где k - номер письма на сервере, а idmessage1 - это компонент, в который будет вноситься информация[/i]

- для получения размера письма:
[b]size:=IdPOP31.RetrieveMsgSize(k)[/b], [i]где size - это переменная под размер, а k - номер письма на сервере. Размер приходит в байтах[/i]

Оценка за ответ: 5.

Текст вопроса:

Компонент для отображения баров (свеч) мне никто не помог найти, следовательно прийдётся писать самому. Вопрос такой: как можно определить свой вид точки в TSeries (Tchart)? Напомню, что, например, свеча характеризуется 4-мя значениями: открытие, максимум, минимум, закрытие. На графике отображается в виде цельной фигуры: горизонтальные чёрточки(открытие, закрытие) к вертикальной черте (разница между максимумом и минимумом). Неужели придётся создавать 2 TSeries c разным типом точек и потом их просто совмещать? Спасибо

Вопрос задал участник: mvp
Дата и время отправки вопроса: 17.05.2006, 17:43
Всего ответов: 1
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Вадим К (статус: Практикант), 18.05.2006, 10:55]:

А не проще будет компонент написать?
Если сделать ряд допущений, то нарисовать будет не так и сложно. А с TChart'ом кажеться не получиться.

Оценка за ответ: 3.
Комментарий: Компонент писать - не один день - очень много подводных камней (например, растяжение графика в run-time и т. п.) Лучше от чего-то отталкиваться.

Текст вопроса:

Как в собственных функциях прописать необязательные для указания параметры?

Вопрос задал участник: Ситников К.Е.
Дата и время отправки вопроса: 19.05.2006, 19:25
Всего ответов: 6
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Евгений В (статус: 1-ый класс), 19.05.2006, 19:47]:

function MyFunktion:integer;
var
//переменные
begin
//Выражение
end;
Если я правильно Вас понял...

Оценка за ответ: 5.

2. [Отвечает: Мартемьянов А.Б. (статус: 4-ый класс), 19.05.2006, 22:21]:

Ясли я правильно понял вопрос, ты хочешь получить функцию наподобие Inc(), в которой может быть 1 или 2 параметра(для данного примера) (например, inc(i,2) или inc(i)).
Такие функции поддерживаются кажется начиная с Delphi 5. Называются они то-ли переопределяемые, то ли перегружаемые, точно не помню. Их суть такова:
Ты пишешь 2 или более одноименные функции(см.приложение). Далее при вызове ф-и increment если ты передаешь в нее 1 параметр- то выполняется первая функция, если передаешь 2 переметра- то выполняется вторая. Таким образом ты как бы получаешь функцию с необязательным (вторым) параметром

Приложение:

function increment(param1:integer):integer; begin result :=param1+1; end; function increment(param1,param2:integer):integer; begin result :=param1+param2; end;

Оценка за ответ: 5.

3. [Отвечает: Евгений Козаченко (статус: 2-ой класс), 19.05.2006, 19:56]:

Эти параметры называются парамеирами по умолчанию. Они должны быть расположены в конце списка параметров в таком виде:
<параметр>:<тип параметра>=значение по умолчанию
Например:

Приложение:

function abc(a:string;b:string;c:string='!!!'):boolean;

Оценка за ответ: 5.

4. [Отвечает: Матвеев Игорь Владимирович (статус: Практикант), 20.05.2006, 04:26]:

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

Тебе нужно просто указать значение аргумента по-умолчанию, смотри приложение - параметр param2 можно не указывать - тогда в функции оно будет False.

Приложение:

function MyFunc(param1: integer; param2: boolean = False): Boolean; begin // *** end;

Оценка за ответ: 5.

5. [Отвечает: Вадим К (статус: Практикант), 22.05.2006, 11:32]:

Есть один важный момент в этих способах задания функций. Нужно писать так, что бы компилятор всегда мог "угадать", какую функцию вызвать.
К примеру я могу объявить две функции вида
function xxx(a:byte=1;b:real=3):boolean;overload;
function xxx(a:integer=1):boolean;overload;
Если вызвать функцию без параметров, то компилятор будет ругаться.overload - ето указание компилятору, что я создаю перегруженую функцию.
И второй важный момент, параметры по умолчанию должны быть справа в объявлении функции.
тоесть, приведённое ниже - недопустимо
function d(a:integer=1;b:real):boolean;

6. [Отвечает: Darya Ermakova (статус: Специалист), 22.05.2006, 12:26]:

Нужно задать этим параметрам значение при объявлении функции. Например так:
procedure MessageShow(s2: string; s1: string = 'Hello');
begin
ShowMessage(s1+s2);
end;

Тогда при вызове процедуры можно задать значение только s2:
MessageShow(' there');

Текст вопроса:

Добрый день. Случилась следующая проблемка. Разрабатываю адаптивную систему тестирования знаний. БД на Access, интерфейс на Delphi6(естественно). БД состоит из нескольких таблиц (основные сущности и таблицы справочного характера). Имеется 4 пользовательских представления: администратор, экзаменатор, эксперт и студент. Админ регистрирует экспертов и экзаменаторов; эксперт составляет тесты по предметам посредством имеющихся шаблонов; экзаменатор регистрирует студентов и распечатывает протоколы; студент проходит тестирование по выбранной теме и в конце получает протокол с результатами. Трагедия происходит именно при написании "студенческой" части. Не понимаю в какой последовательности нужно производить запись в протокол и в базу ответы студента. Какими компанентами пользоваться. Если загружаю в какой нибудь DBMemo вопросы из Базы Вопросов, то не получается вывести ответы для выбора (пробовала DBLookupComboBox-ом, DBRadioGroup-ом и др.)Неговоря уже о сравнении выбранных студентом ответах и верными, и о подсчете результатов). К тому же так как это адаптивное тестирование, то при верном/неверном ответе на конкретный вопрос уровень сложности следующего должен повышаться/понижаться. Вобщем, хоть вешайся........... Если что, заранее спасибо!!!

Приложение:

Основные типы сущностей: - Студент – Student; - Администратор – Administrator; - Эксперть – Expert; - Экзаменатор – Examenator; - Предмет – Subject; - Тема – Theme; - Протокол – Protocol; - База вопросов – Base Of Questions; - База вариантов ответа – Base Of Answers; - Ответы студента – Student Answers; - Тип вопроса – Type Of Question; - Уровень сложности – Level; - Балл – Ball; Пыталась вставить таблицу с описанием параметров..... Не получилось...... СУЩНОСТЬ Атрибуты Описание Тип данных Размер даных Пустые значеничя Многозначность № Имя сущности Тип сушности 1 STudent Физически сущ. Сильный ST_StudentNo Однозначно определяет студента Integer Строка длиной до 5 символов НЕТ НЕТ ST_FName Имя студента String Текстовая строка НЕТ НЕТ ST_LName Фамилия студента String Текстовая строка НЕТ НЕТ ST_Patronymic Отчество студента String Текстовая строка НЕТ НЕТ ST_Group Группа Integer Строка длиной до 5 символов ДА НЕТ ST_Course Курс Integer Cимвол НЕТ НЕТ ST_Faculty Факультет String Текстовая строка НЕТ НЕТ ST_NumberOf TestBook Номер зачетной книжки Строка длиной до 6 символов НЕТ НЕТ ST_Login Регистрационное имя Text НЕТ НЕТ ST_Password Пароль Text НЕТ НЕТ 2 ADMinistrator Физически сущ. Сильный ADMinistratorNo Однозначно определяет администратора НЕТ НЕТ Name Регистрационное имя String Текстовая строка НЕТ НЕТ PASsword Пароль НЕТ НЕТ 3 EXPert Физически сущ. Сильный EXPertNo Однозначно определяет эксперта НЕТ НЕТ LOGin Регистрационное имя НЕТ НЕТ PASsword Пароль НЕТ НЕТ FName Имя String Текстовая строка НЕТ НЕТ LName Фамилия String Текстовая строка НЕТ НЕТ PATronymic Отчество String Текстовая строка НЕТ НЕТ 4 EXAMenator Физически сущ. Сильный EXAMenatorNo Однозначно определяет экзаменатора НЕТ НЕТ LOGin Регистрационное имя НЕТ НЕТ PASsword Пароль НЕТ НЕТ FName Имя String Текстовая строка НЕТ НЕТ LName Фамилия String Текстовая строка НЕТ НЕТ PATronymic Отчество String Текстовая строка НЕТ НЕТ APPointment Однозначно определяет должность String Текстовая строка НЕТ НЕТ CHair Однозначно определяет кафедру String Текстовая строка НЕТ НЕТ 5 SUBject Абстрактная Сильный SUBjectNo Однозначно определяет предмет НЕТ НЕТ SUBNaMe Наименование предмета String Текстовая строка НЕТ НЕТ SUBCourse Курс, на кот-м изучают предмет WideChar Слово - символ НЕТ ДА SUBGRoup Группа НЕТ ДА SUBFACulty Факультет String Текстовая строка НЕТ ДА SUBSPeciality Специальность String Текстовая строка НЕТ ДА 6 THeme Абстрактная Слабый (не сущ. без предмета) THemeNo Однозначно определяет тему НЕТ НЕТ THNaMe Наименование темы String Текстовая строка НЕТ ДА THSUBject Наименование предмета String Текстовая строка НЕТ ДА 7 PROTocol Физически сущ. Слабый (не сущ. без студента) PROTocolNo Однозначно определяет протокол НЕТ НЕТ PROTocolDATE Дата тестирования TdateTime Значение даты и времени НЕТ НЕТ PROTocolTIME Время тестирования TdateTime Значение даты и времени НЕТ НЕТ PROTSTudent Студент, прошедший тестир-е String Текстовая строка НЕТ НЕТ PROTSUBject Предмет, по кот. проходило тестир-е String Текстовая строка НЕТ НЕТ PROTTHeme Тема, по кот. проходило тестир-е String Текстовая строка НЕТ НЕТ PROTQUESTions Вопросы на которые отвечал студент String Текстовая строка НЕТ НЕТ PROTSTudentANSWers Ответы студента на заданные вопросы String Текстовая строка НЕТ НЕТ 8 Base Of Questions Абстрактная Слабый (не сущ. без предмета и темы) BaseOfQuestionsNo Однозначно определяет базу вопросов НЕТ НЕТ BOQSUBject Предмет, по кот-му сущ. вопросы String Текстовая строка НЕТ НЕТ BOQTHeme Тема, по кот-й сущ. вопросы String Текстовая строка НЕТ НЕТ BOQTYpe Тип вопроса НЕТ НЕТ BOQTExt Текст вопроса String Текстовая строка НЕТ НЕТ 9 Base Of Answers Абстрактная Слабый (не сущ. без вопросов) BaseOfAnswersNo Однозначно определяет базу ответов НЕТ НЕТ BOAQUEstions Вопросы из базы String Текстовая строка НЕТ НЕТ BOAANSwers Ответы на вопросы из базы String Текстовая строка НЕТ НЕТ BOABAll Балл, дающийся за правильный ответ НЕТ НЕТ 10 STudent Answers Абстрактная Слабый (не сущ. без заданных вопросов) STudentAnswersNo Однозначно определяет ответы студента String Текстовая строка НЕТ НЕТ STANUmber Номер вопроса, на кот. отвечал студент НЕТ НЕТ STAANSwer Ответ студента String Текстовая строка НЕТ НЕТ 11 LEVel Абстрактная Слабый LEVelNo Однозначно определяет уровень сложности вопроса НЕТ НЕТ LEVelName Наименование уровня сложности String Текстовая строка НЕТ НЕТ LEVelBall Балл, дающийся за правильный ответ НЕТ НЕТ ?? Ball Однозначно определяет набранный балл НЕТ НЕТ 12 Type Of Questions Абстрактная Слабый Однозначно определяет тип вопроса НЕТ НЕТ

Вопрос задал участник: Иванова Параска Федоровна
Дата и время отправки вопроса: 20.05.2006, 19:38
Всего ответов: 1
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: Помфюк Владимир Степанович (статус: Практикант), 22.05.2006, 10:47]:

Насколько я понимаю Вам надо выбрать случайным образом первый вопрос, предполагая, что его сложность средняя (предположим 3 по 5-бальной шкале). Запрос такой: select * from question where level=3; Какими компонентами - Ваш выбор. Чтоб не таскать за собой BDE посоветовал бы ADO-компоненты. Дальше - каким-нибудь random'ом выбрать случайную запись. Потом - выбрать варианты ответов на этот вопрос. Потом - принять ответ студента, например через DBRadioGroup или через DBLookupComboBox. Следующий шаг - проверить был ли выбран правильный вариант, если да - поднять уровень сложности, если нет - снизить. Дальше - все сначала, только с новым уровнем сложности.

Текст вопроса:

Здравствуйте! Подскажите пожалуйста такую вещь: как средствами Delphi отслеживать сетевой трафик (ADSL, если это имеет значение)? За ранее, спасибо!

Вопрос задал участник: Евгений В
Дата и время отправки вопроса: 20.05.2006, 19:52
Всего ответов: 2
Страница данного вопроса >>

Ответы на данный вопрос:

1. [Отвечает: mvp (статус: Студент), 20.05.2006, 20:07]:

Скачайте програмку с исходниками на delphi, которая считает трафик:

http://www.delphi.int.ru/files/sources/sources_n/nettrafmonitor.zip

Оценка за ответ: 5.
Комментарий: &#1057;&#1087;&#1072;&#1089;&#1080;&#1073;&#1086;!

2. [Отвечает: Степанов Игорь Николаевич (статус: 6-ой класс), 21.05.2006, 15:10]:

Что бы отследить трафик, нужно написать снифер. Посмотри в инете исходники.

Оценка за ответ: 5.
Комментарий: Спасибо!