Отправляет email-рассылки с помощью сервиса Sendsay

Программирование на Delphi

  Все выпуски  

Программирование на Delphi (выпуск 35)


Информационный Канал Subscribe.Ru

Программирование на DELPHI
Выпуск #35 (05 ноября 2005 г.) 

Разделы сайта:

Новости сайта
Система "Эксперт"
Вопросы и Ответы

Отправить вопрос
Файловый архив
Статьи
Компоненты
Plug-in's
Документация
Исходники
Изображения
Игры
Программы
Форум
Гостевая книга
F.A.Q.
Архив рассылки
Каталог сайтов
Обратная связь
Хостинг



Связь:

Администратор
Система "Эксперт"
Информация


Доброго времени суток, уважаемые читатели!

В связи с техническими неполадками, сайт http://www.delphi.int.ru/ в последние дни работал нестабильно. Скорее всего, ещё несколько дней это продолжится и некоторые страницы будут не открываться, а некоторые файлы - не загружаться. В связи с этим обновление сайта придётся временно прекратить и на сегодня новых файлов на сайте нет. Через несколько дней всё должно восстановиться. Приносим извинения за неудобства.

Убедительная просьба к экспертам: если приводите большой кусок кода, оформляйте его в виде pas-файла, а не вставляйте в текст ответа.

Ну а теперь главная новость: завтра, 6-го ноября, нашему проекту исполняется ровно год! Год назад была открыта данная рассылка и был зарегистрирован сайт. Достаточно знаменательная дата!

[Ответить]

До встречи!

Разделы рассылки:

Авторское слово
Новые вопросы
Ответы на вопросы
Статья по Delphi
Файловый архив
Друзья
Юмор


Количество читателей рассылки: 3542.


Подписка на рассылку:


Лидеры по количеству баллов:


Место
Имя
Баллы
Статус
1
Feniks
281
Практикант
2
Dron
265
Практикант
3
Ermakova Dasha
259
Практикант
4

Садовников Владимир

229
Практикант
5
Iron Monk
200
Практикант
6

Ершов Денис

106
Студент
7

mvp

105
Студент
8
Лучников А.И.
98
Эксперт: 10-ой класс
9

VeroLom

82
Эксперт: 9-ый класс
10
Igor Danilevych
81
Эксперт: 9-ый класс

Статусы экспертов и их возможности:

Статус
Необходимое кол-во баллов
Прикрепление файлов
Форматирование текста
Посетитель
0
нет
нет
Эксперт 1-го класса
1
нет
нет
Эксперт 2-го класса
10
нет
нет
Эксперт 3-го класса
20
нет
нет
Эксперт 4-го класса
30
нет
нет
Эксперт 5-го класса
40
нет
нет
Эксперт 6-го класса
50
до 250 Кб
нет
Эксперт 7-го класса
60
до 250 Кб
нет
Эксперт 8-го класса
70
до 250 Кб
нет
Эксперт 9-го класса
80
до 250 Кб
нет
Эксперт 10-го класса
90
до 250 Кб
нет
Студент
100
до 250 Кб
нет
Практикант
150
до 250 Кб
нет
Специалист
300
до 250 Кб
да
Профессионал
500
до 1 Мб
да
Профессор
800
до 1 Мб
да
Академик
1000
до 1 Мб
да

Примечание: Под форматированием текста понимается возможность оформлять ответы с использованием html-тегов.

Если Вы хотите, чтобы Вашего имени (ника) не было в данной таблице, отправьте письмо по этой ссылке с зарегистрированного у нас адреса. В теле письма, пожалуйста, укажите причину удаления имени из таблицы. Нам важно ваше мнение.


Основные правила нашей рассылки:

1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, объёмом выше установленного ограничения (ограничения указаны в правилах).
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не обрабатываются! Используйте текстовый (не HTML) формат писем. HTML-теги применяйте только в том случае, если Вы уже достигли статуса, где это разрешено (см. правила).
5. Запрещено задавать вопросы, содержащие два (или несколько) вопросов разной тематики. Каждый из таких вопросов должен быть оформлен отдельным письмом.


Задать вопрос в рассылку
   |   Задать вопрос с помощью web-формы   |   Система "Эксперт"


Новые вопросы.


Вопрос #180 (автор вопроса: wvw; вопрос отправлен: 23.10.2005 19:04):

Подскажите пожалуйста! Работаю с реестром - необходимо создать программно двоичный параметр со значением 0A ff и пожалуйста пример кода. Заранее благодарен. [Ответить на вопрос]


Вопрос #181 (автор вопроса: pena; вопрос отправлен: 24.10.2005 14:52):

Как взять из Word картинку и вставить в мою базу данных? [Ответить на вопрос]


Вопрос #182 (автор вопроса: l.yz; вопрос отправлен: 25.10.2005 16:10):

Как сделать так, чтобы прога автоматически загружалась при включении компа? [Ответить на вопрос]


Вопрос #183 (автор вопроса: Vitek; вопрос отправлен: 26.10.2005 21:13):

Подскажите пожалуйста, как осуществить Drag&Drop файлов (и папок) в TShellListView-ах между собой и извне (и наоборот, куда-то в папку).
Спасибо! [Ответить на вопрос]


Вопрос #184 (автор вопроса: Ершов Денис; вопрос отправлен: 27.10.2005 14:48):

Delphi 7. Использую ListView в режиме vsReport для отображения статистики. Необходимо организовать слежение за добавленными записями. Проблему решил скроллингом компонента на всю длину записей - методом Scroll, однако этот метод не имеет действия при запуске программы (ни в OnCreate, ни в OnShow) от него пользы нет. Как обеспечить скроллинг компонента при запуске? Есть что-нибудь изящнее, чем скроллировать по таймеру? [Ответить на вопрос]


Вопрос #185 (автор вопроса: Ершов Денис; вопрос отправлен: 28.10.2005 13:27):

В настройках Windows есть такая предательская настройка, как размер системного шрифта. В результате, если этот параметр у разработчика и пользователя имеет разное значение, это плачевно сказывается на внешнем виде формы. В одних случаях контролы наплывают друг на друга и уходят за край формы, что чревато ее скроллингом, в других - появляется много свободного места. Есть успешные решения данной проблемы? [Ответить на вопрос]


Вопрос #186 (автор вопроса: Владимир Петрухин; вопрос отправлен: 28.10.2005 20:39):

Здравствуйте! Пишу первую в жизни DLL. В ней функция заполняющая динамический массив случайными числами. В uses прописал ShareMem. Проблема - Не получается передать этот массив, точнее, указатель в программу. Объявление function masss(n:integer):array of integer; не проходит. подскажите что делать? Если можно с примером. [Ответить на вопрос]


Вопрос #187 (автор вопроса: mk; вопрос отправлен: 31.10.2005 22:30):

Кто знает методы, свойства и события компонента ShellListView на вкладке Samples и их описания подскажите пожалуйста. [Ответить на вопрос]


Вопрос #188 (автор вопроса: Vitaly; вопрос отправлен: 02.11.2005 08:10):

Помогите написать программу, которая подсчитывает трафик в ЛВС? Или подскажите как? Исходные данные: целью этого проекта является разработка программы для одного уникального узла, который не участвует в сетевых операциях, а контролирует и анализирует все кадры, передаваемые в сетевой среде. [Ответить на вопрос]


Вопрос #189 (автор вопроса: dmn; вопрос отправлен: 02.11.2005 09:21):

Как программно перехватить имя файла, если запускаешь его в меню "Открыть с помощью", или задать ассоциацию так, чтобы файл при двойном щелчке открывался именно твоей программой? [Ответить на вопрос]



Вопросы, оставшиеся без ответа:

Вопрос #90 (автор вопроса: Nanny_Jagg; вопрос отправлен: 17.03.2005 07:56):

Как в DBGrid из библиотеки Ehlib 3.6 добавить Lookup-поле, чтобы оно действительно работало? Поле вроде сделано, но ключевое поле, оставленное рядом для контрола не меняется, по какому событию обработчик писать? [Ответить на вопрос]


Вопрос #176 (автор вопроса: Тимур; вопрос отправлен: 12.10.2005 13:58):

Нужно программно узнать температуру процессора. Мать Abit NF7-S (или любая другая) с микросхемой мониторинга Winbond W83627HF. [Ответить на вопрос]

 


Ответы на вопросы.


Вопрос #88:
Вопрос по TChart. Как осуществить привязку указателя мыши к линии LineSeries? И еще. По оси X - время (DateTime). Как "вытащить" значение Y в любой точке LineSeries?

1. [Отвечает: Матвеев И.В,, 24.10.2005 13:39]: Толком не понял, что значит "Как осуществить привязку указателя мыши к линии LineSeries?", возможно вам стоит переформулировать вопрос. По-поводу второго вопроса, в TSeries.XValues хранятся все X значения по оси X. Если у Вас стоит задача найти Y значение для времени, когда снимались показания, т.е. в серию была добавлена точка, Вам нужно просто произвести поиск по значениям TSeries.XValues, и взять результат из TSeries.YValues. Если же вам необходимо узнать Y значение для времени в общем случае, вам необходимо найти в TSeries.XValues ближайшие значения к искомому времени. Смотрите прикрепленный рисунок. Загрузить прикреплённый файл >>

Файл пока недоступен, подробности в начале выпуска (прим. ред.)

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


Вопрос #149:
Добрый день. Подскажите пожалуйста, каким образом программа (пишу в Delphi 5) может изменить параметры электропитания WindowsXP (или хоть какой-то)? Конкретно – время выключения монитора. Заранее благодарю, Александр Прохода.

3. [Отвечает: Матвеев И.В., 24.10.2005 15:49]: Проследил RegMon'ом и нашел ключ HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Controls Folder\PowerCfg. Он содержит параметры электропитания компьютера, а в подключе PowerPolicies хранятся готовые схемы с описанием, это можно использовать для того, чтобы выяснить в каком формате хранится параметры электропитания. По-видимому в подключе GlobalPowerPolicy в Policies (тип REG_BINARY) хранятся все параметры электропитания. Вам остается только выяснить, где там время отключения монитора.

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


Вопрос #169:
Скажите пожалуйста, каким образом заполнение ProgressBar можно связать с выполнением процедуры CopyFile? Спасибо.

1. [Отвечает: Сергей, 23.10.2005 02:15]: Прямого ответа на Ваш вопрос я не знаю, но может эта функция поможет Вам. Функция копирует файл FileName в файл FileNew, процесс копирования показывается на ProgressBar.
Function CopiFiles(ProgressBar:TProgressBar;FileName,FileNew:string):boolean;
var Buf: array[1..4096] of Byte;
FRead,FWrite:integer;
FLoad,FSave:File;
begin
Rusult:=true;
If FileName<>FileNew then begin
AssignFile(FLoad,FileName);
{$I-}Reset(FLoad,1);{$I+}
If Ioresult=0 then begin
AssignFile(FSave,FileNew);
{$I-}Rewrite(FSave,1);{$I+}
If Ioresult=0 then begin
PRogressBar.Max:=FileSize(Fload);
repeat {Используем 'паскалевские' процедуры работы с нетипизированными файлами}
BlockRead(FLoad, Buf, SizeOf(Buf), FRead);
ProgressBar.Position:=ProgressBar.Position+SizeOf(Buf);
BlockWrite(FSave, Buf, FRead, FWrite);
until (FRead = 0) or (FWrite <> FRead);
CloseFile(FSave);
end else Result:=false;
CloseFile(FLoad);
end else Result:=false;
end else Result:=false;
end;

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

2. [Отвечает: Садовников Владимир, 23.10.2005 22:22]: На мой взгляд, проще написать процедуру копирования файлов (а лучше даже оформить это в виде отдельной нити), и в ней менять значение прогресса. Например:

unit CopyThread;

interface

uses
  Classes, ComCtrls, Windows, SysUtils;

type
  TCopyThread = class(TThread)
  public
    constructor Create(FromF,ToF:string;Progr:TProgressBar);
  private
    { Private declarations }
    FProgr:TProgressBar;
    FA,FB:string;
    FFileSize:Integer;
    FCopied:Integer;

    procedure UpdateProgress;
    procedure SetupProgress;
  protected
    procedure Execute; override;
  end;

implementation

constructor TCopyThread.Create(FromF, ToF: string; Progr: TProgressBar);
begin
  inherited Create(true);
  FProgr:=Progr;
  FA:=FromF;
  FB:=ToF;
  FCopied:=0;
  FFileSize:=0;

  Resume();
end;

procedure TCopyThread.Execute;
var
  A,B:THandle;
  MaxCopy:Integer;
  Hight:DWORD;
  Buffer:array of Integer;
begin
  { Place thread code here }
  if (FileExists(FA)) then
    begin
      A:=FileOpen(FA,fmOpenRead);
      if (A<>0) then
        begin
          FFileSize:=GetFileSize(A,@Hight);
          Synchronize(SetupProgress);
          B:=FileCreate(FB);
          SetLength(Buffer,32768);
          if (B<>0) then
            begin
              while (FCopied<FFileSize) do
                begin
                  MaxCopy:=(FFileSize-FCopied);
                  if (MaxCopy>32768) then
                    MaxCopy:=32768;
                  FileRead(A,Buffer[0],MaxCopy);
                  FileWrite(B,Buffer[0],MaxCopy);
                  FCopied:=FCopied+MaxCopy;
                  Synchronize(UpdateProgress);
                end;
            end;
          Buffer:=nil;
        end;
    end;
end;

procedure TCopyThread.SetupProgress;
begin
  FProgr.Max:=FFileSize;
end;

procedure TCopyThread.UpdateProgress;
begin
  FProgr.Position:=FCopied;
end;

end.

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

3. [Отвечает: Маренич Владимир, 24.10.2005 11:57]: CopyFile - Windows API функция, а ProgressBar - это компонент Delphi. Их связать никак нельзя. Если хотите показывать прогресс копирования, то нужно его реализовать самому: создаете два потока - один для чтения, второй для записи. Читаете кусками, например, по 32 кб и записываете во второй поток, показываете в ProgressBar'е. И так до конца файла.

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

4. [Отвечает: Dron, 24.10.2005 14:32]: Процедура CopyFile - системная процедура и контроллировать процесс её выполнения нельзя. В данном случае самым разумным способом будет использовать функции BlockRead и BlockWrite, т.е. чтение и запись файла фрагментами. Пример использования прикрепляю к ответу. Загрузить прикреплённый файл >>

Файл пока недоступен, подробности в начале выпуска (прим. ред.)

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

5. [Отвечает: Матвеев И.В., 24.10.2005 15:49]: Вам необходимо реализовать свой CopyFile. Интерфейс может быть такой:

type
TProgressProc = procedure (Percent: Integer);

function XCopyFile(Source, Dest: string; ProgressProc: TProgressProc): Boolean;

Функция XCopyFile копирует файл кусками определенного размера, возвращая управление в ProgressProc после копирования, скажем каждых 5 процентов.

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

6. [Отвечает: Антон Трапезников, 25.10.2005 17:21]: К CopyFile привязать Progressbar можно только при условии копирования файлов, размер которых, примерно, одинаков (увеличивать Progressbar после копирования очередного файла). Хотя, может, я чего-то не знаю... Проще использовать копирование методом файловых потоков. Например, увеличивать значение ProgressBar'а после копирование очередного блока: Протестировал все на D6. На форме две кнопки и ProgressBar. Button1 - копирование; Button2 - отмена.

var CancelOperation:Boolean; // Глобальное объявление

..........................

procedure TForm1.Button1Click(Sender: TObject);

const
BlockSize = 65536;
// изменение этого значения на любое другое,
// отличное от указанного, приводит к
// увеличению времени копирования!!!

var
ElapsedSize, CopySize: Integer;
SourceStream, TargetStream: TFileStream;
Source, Target: String;

begin
CancelOperation:=False;
Source:='c:\copy\testfile.dat';
Target:='c:\testfile.dat';

SourceStream:=TFileStream.Create(Source,fmOpenRead);
TargetStream:=TFileStream.Create(Target,fmCreate);

ElapsedSize:=SourceStream.Size - SourceStream.Position;
ProgressBar1.Max:=SourceStream.Size;

while ElapsedSize > 0 do
begin
if ElapsedSize < BlockSize
then CopySize:=ElapsedSize
else
CopySize:=BlockSize;

TargetStream.CopyFrom(SourceStream,CopySize);
ElapsedSize:=SourceStream.Size - SourceStream.Position;
ProgressBar1.Position:=SourceStream.Position;
// модификация индикатора процесса

Application.ProcessMESSAGES;
// чтобы окно и все, что на нем находится реагировало
// на изменения (нажатие кнопки, перерисовка в случае
// перекрытия ...)

if CancelOperation then Break;
// если пользователь нажал кнопку отмены копирования

end; // while

FileSetDate(TargetStream.Handle, FileGetDate(SourceStream.Handle));

TargetStream.Free;
SourceStream.Free;

if CancelOperation then DeleteFile(Target);

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CancelOperation:=True;
Close;
end;

Я тут подумал и хочу еще добавить, что в примере, который я послал выше, самое "узкое" место это скорость. Поэтому, все-таки лучше не использовать Aplication.ProcessMessages, а вставить код в отдельный поток и задать для него нужный приоритет. Еще один "потребитель" ресурсов, это сам ProgressBar, и если делать что-то вроде ProgressBar.Max:=SourceStream.Size, то эта инструкция может тормозить обработку файла.

Может быть, стоит установить Progressbar.Max на любое число (например 100), и узнавать сколько процентов от общего размера файлов уже обработано. Короче, имеется большая почва для экспериментов...

И напоследок, если скорость действительно важна, то стоит это все описать в .dll (на ассемблере), которую вызывать в отдельном потоке.

Удачи!

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

7. [Отвечает: mvp, 27.10.2005 02:01]: Связать с copyFile не получится, можно использовать CopyFileEx или ReadBlock/WriteBlock или TStream. Пример взят с http://forum.sources.ru/index.php?showtopic=79211 c функцией CopyFileEx. Я только перевёл комментарии и совсем чуточку изменил входной параметр.

Function CopyCallBack(

TotalFileSize: LARGE_INTEGER; // Размер файла в байтах

TotalBytesTransferred: LARGE_INTEGER; // Количество скопированных байт

StreamSize: LARGE_INTEGER; // Размер буфера копирования

StreamBytesTransferred: LARGE_INTEGER; // Количество байт в буфере

dwStreamNumber: DWord; // номер буфера

dwCallbackReason: DWord; // ?Reason for the call back.

hSourceFile: THandle; // Хендл исходного файла

hDestinationFile: THandle; // Хендл записываемого файла

ProgressBar : TProgressBar // Параметр передаётся при вызове
CopyFileEx

): DWord; far; stdcall;

var

EnCours: Int64;

begin

//Высчитываем позицию progressBar в процентах. Используется тип Int64 во
избежание переполнений

EnCours := TotalBytesTransferred.QuadPart*100 div
TotalFileSize.QuadPart;

if ProgressBar<>Nil then ProgressBar.Position := EnCours;

//Этот коллбэк должен определить, будет ли продолжена копирование. В
нашем случае - да.

Result := PROGRESS_CONTINUE;

Application.ProcessMessages; // Даём приложению обработать
скопившиеся сообщения

end;

Function FileCopy(Const SourceFn, TargetFn : String; Bar : TProgressBar =
nil):

Boolean;

Var I : Integer; Retour: LongBool;

begin

Result:=True; // Результат по умолчанию - файл скопирован

If (Win32Platform = Ver_Platform_Win32_NT) and (Bar <> nil)

then begin { CopyFileEx работает только на WinNT, 2000 or XP }

Bar.Visible:=True; // Показывать progressbar только во время
копирования

Retour := False; // ?NB CopyFileEx only works on WinNT,2k or XP.}

if not CopyFileEx(

PChar(SourceFn), // Исходный файл

PChar(TargetFn), // Куда копировать

@CopyCallBack, // Адрес коллбэка

Bar, // ProgressBar, который будет показывать состояние
копирования

@Retour, // ?Address of Boolean tested to stop the copy

// ?Don't specify "can be restarted" or "only if
not exists"

then Result:=False;

end else begin

---код, если нет progressBar. Можно тогда и обычный FileCopy применить---

end;

end;

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

8. [Отвечает: dasha ermakova, 30.10.2005 23:45]: procedure TForm1.Button1Click(Sender: TObject);
var
CopyBuffer: Pointer;
Source, Destination: string;
Src, Dest, BytesCopied, SumBytes, FSize, Pos: integer;
F: file;
RO: bool;
const
ChunkSize: LongInt = 8192;

begin
GetMem(CopyBuffer,ChunkSize);
Source:=SourceFileName;
if FileIsReadOnly(Source) = true then
begin
FileSetReadOnly(Source,false);
RO:=true;
end
else
RO:=false;

if RO = true then
begin
AssignFile(F,Source);
Reset(F);
FSize:=FileSize(F);
FileSetReadOnly(Source,true);
CloseFile(F);
end;
Destination:=DestinationFileName;
Src:=FileOpen(Source,fmShareDenyWrite);
Dest:=FileCreate(Destination);
if RO = true then
FileSetReadOnly(Destination,true);
SumBytes:=0;
repeat
BytesCopied:=FileRead(Src,CopyBuffer^,ChunkSize);
if BytesCopied>0 then
begin
FileWrite(Dest,CopyBuffer^,BytesCopied);
Inc(SumBytes,BytesCopied);
Pos:=Round((SumBytes/FSize)*100);
end
else
Pos:=0;
ProgressBar1.Position:=Pos;
Application.ProcessMessages;
if Application.Terminated then break;
until
BytesCopied<ChunkSize;
FileClose(Dest);
FileClose(Src);
FreeMem(CopyBuffer,ChunkSize);
end;

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


Вопрос #170:
Имея WebBrowser пытаюсь его распечатать. Делаю так: begin Webbrowser1.Navigate('file:///c:your_name.html'); end; ... begin try WebBrowser1.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER); except on E:Exception do ShowMessage(E.message); end; end; Если выключить принтер, то по идее, я должен получить сообщение о том, что печать страницы не была выполнена, но в своём приложении этого сообщения я не отлавливаю, а хотелось бы. прошу помощи у всезнающего all. Заранее благодарен за правильный код и действительно работающий. За уникальность кода (Win 9x/XP) буду вдвойне признателен.

1. [Отвечает: Антон Трапезников, 25.10.2005 09:35]: Здравствуйте, SHKoder!

procedure TForm1.Button1Click(Sender: TObject);
begin
WebBrowser1.Navigate('file:///c:\your_name.html');
end;

// Печать без диалога

procedure TForm1.Button2Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER,
vaIn, vaOut);
end;

// Печать с вызовом диалога

procedure TForm1.Button3Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

// Предварительный просмотр

procedure TForm1.Button4Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

// Параметры страницы

procedure TForm1.Button5Click(Sender: TObject);
var
vaIn, vaOut: OleVariant;
begin
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER,
vaIn, vaOut);
end;

Надеюсь, что помог. Удачи!

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


Вопрос #171:
Добрый день! 1. Подскажите, как можно текстовый файл, загруженный в Memo порезать на куски и те данные занести в базу данных, например dbf? 2. Как в текстовом файле сделать поиск не по первому в строке символу а по произвольному из строки?

1. [Отвечает: VeroLom, 24.10.2005 01:25]: Самое простое - брать первые N (длина искомого) символов и сравнивать и искомой строкой. Если не подходит - перемещаться на 1 символ.

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

2. [Отвечает: Лучников А.И., 24.10.2005 14:41]: Не совсем ясны вопросы... 1. В мемо можно пользовать TMemo.Items - аналог (почти) TStringList. Вырезать значения (и манипулировать ими) можно как из Strings[n], так и из свойства Text. 2. Простое решение (но глупое) - перебор значений, второй вариант - сделать копию в (опять же) TStringList (временном), и искать по циклу функцией pos в свойстве Text, удаляя всё до найденного вхождения (или включая его). Копию можно сделать так:

ListFile:=TStringList.Create;
ListFile.LoadFromFile('MyFile.txt');
CopyListFile:=TStringList.Create;
CopyListFile.Assign(ListFile); // собственно копия.

Далее - по контексту задачи.

PS. Не забыть сделать ListFile.Free; CopyListFileFree;

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

3. [Отвечает: dasha ermakova, 24.10.2005 11:57]: 1) Не пойму в чем проблема. Если в том, чтобы порезать на куски нужного размера, то нужно поставить, например, специальные символы, по которым определять размер кусков, или по длине строки копировать. А для занесения данных в существующую таблицу пишем, например:

Table1.Append;
Table1.Fields[0].AsString:=Copy(Memo1.Text,BeginNum,EndNum);
Table1.Fields[1].AsString...

2) Для этого есть функция:

PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;

Offset - номер символа, с которого нужно начать поиск, по умолчанию первый.

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


Вопрос #172:
Здравствуйте! У меня такой вопрос: как определить, какой процесс использует данную папку и как он ее использует (для чтения(самое важное) для записи и т.д.) ? Т.е. если пользователь открыл папку или смотрит ее в Total Comander'e (осуществляет доступ к папке), то показывается сообщение. Ну что-то наподобие FileMon'a, только мне нужен код на Delphi 7. Т.е мне нужно узнать какой процесс читает данную папку. Заранее спасибо.

1. [Отвечает: Матвеев И.В., 25.10.2005 02:41]: Я тоже искал ответ на этот вопрос, поскольку иногда нужно что-то удалить, но это что-то чем-то используется. Я нашел Process Explorer (www.sysinternals.com) - он умеет это делать.

Если же Вам нужно реализовать это в своей программе, Вы должны исходить из того, что открытые и используемые кем-то папки/файлы имеют ручку THandle, полученную от CreateFileA/CreateFileW, которую, по-видимому, и следует искать.

Извиняюсь, что далее пишу сырую информацию, быть может до выхода рассылки я решу эту проблему и автор исправит этот вариант.

Отладчиком я выяснил, что Process Explorer использует функцию GetTokenInformation, в 7-ом аргументе передается указатель на проверяемую строку.

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


Вопрос #173:
Привет всем! Как сохранить (а потом и загрузить) данные переменной типа WideString? Делаю я так:

1. [Отвечает: Садовников Владимир, 23.10.2005 22:35]: Ну ты дал! Когда грузишь в/из файла, то обращай внимание на размеры операндов:

WideString - не string, и состоит он из элементов WideChar, а не Char, а, как известно, в Win32 SizeOf(WideChar)=2<>SizeOf(Char)=1. Таким образом, в файл ты сливаешь только половину строки, а не всю: надо Length(WideString) на SizeOf(WideChar) умножать при записи. Вот, исправил:

var
Size: Integer;
URL: WideString;
Stream:TFileStream;
begin
URL := 'West-Test';
Size := Length(URL);

Stream:=TFileStream.Create('E:\test.txt',fmCreate);
Stream.Write(Size, SizeOf(Size));
Stream.Write(PWideChar(URL)^, Size*SizeOf(WideChar));
Stream.Destroy;

URL := '';
Stream:=TFileStream.Create('E:\test.txt',fmOpenRead);
Stream.Read(Size, SizeOf(Size));
SetLength(URL, Size);
Stream.Read(PWideChar(URL)^, Size*SizeOf(WideChar));
Stream.Destroy;
end;

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

2. [Отвечает: Ершов Денис, 27.10.2005 15:28]: По коду сразу видно ошибку. Функции Length и SetLength работают не с количеством байт, а с количеством символов WideChar, которые занимают 2 байта, в то время как стандартные потоки оперируют байтами. Поэтому нужно умножать на два количество данных при работе с потоком:

Stream.Write(PWideChar(URL)^, 2 * Size);

и

Stream.Read(PWideChar(URL)^, 2 * Size);

Однако при начальном коде мусор должен появляться лишь во второй половине строки (т.е. 'West*****'). Отсюда возникает вопрос: Правильно ли установлен Position потока? Возможно он установлен не в то же место, откуда начиналась запись.

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

3. [Отвечает: Igor, 27.10.2005 19:02]: Может быть я Вас неправильно понял, но URL у Вас - ЛОКАЛЬНАЯ переменная! Ведь load и save - это процедуры? Да Вы хоть какой тип переменной объявите (не обязательно WideString) - она будет принимать какие угодно значения, но только не те, которые необходимы... Выход?.. Объявите переменную URL как глобальную... Кстати, сам не раз пролетал из-за такой досадной ошибки! P.S. Ещё раз извиняюсь, если неправильно понял вопрос.

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


Вопрос #174:
Здравствуйте! Подскажите, пожалуйста, как создать "Cаption" в TButton или TBitBtn, короче в любом TWinControl вертикально?

1. [Отвечает: Матвеев И.В., 24.10.2005 14:25]: Так как Вы думаете - никак. Выход я вижу в использовании собственного потомка от TSpeedButton, но такая кнопка не будет иметь фокуса. Если же вам важно, чтобы это был именно WinControl - Вы можете использовать сообщение CN_DRAWITEM. В любом случае пройдется писать свой компонент и рисовать текст вертикально вручную.

Привожу пример, с которого вам стоит начать во-втором случае - это цветная кнопка. Измените обработчик TColorBtn.CNDrawItem под себя и получите то, что хотели.

unit colorbtn;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;

type

TColorBtn = class(TButton)
private
FCanvas: TCanvas;
IsFocused: Boolean;
F3DFrame: boolean;
FButtonColor: TColor;
procedure Set3DFrame(Value: boolean);
procedure SetButtonColor(Value: TColor);
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message
WM_LBUTTONDBLCLK;
procedure DrawButtonText(const Caption: string; TRC: TRect; State:
TButtonState; BiDiFlags: Longint);
procedure CalcuateTextPosition(const Caption: string; var TRC: TRect;
BiDiFlags: Longint);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ButtonColor: TColor read FButtonColor write SetButtonColor default
clBtnFace;
property Frame3D: boolean read F3DFrame write Set3DFrame default False;
end;

procedure Register;

implementation

{ TColorBtn }

constructor TColorBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 21;
FCanvas := TCanvas.Create;
FButtonColor := clBtnFace;
F3DFrame := False;
end;

destructor TColorBtn.Destroy;
begin
FCanvas.Free;
inherited Destroy;
end;

procedure TColorBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
Style := Style or BS_OWNERDRAW;
end;

procedure TColorBtn.Set3DFrame(Value: boolean);
begin
if F3DFrame <> Value then
F3DFrame := Value;
end;

procedure TColorBtn.SetButtonColor(Value: TColor);
begin
if FButtonColor <> Value then
begin
FButtonColor := Value;
Invalidate;
end;
end;

procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;

procedure TColorBtn.SetButtonStyle(ADefault: Boolean);
begin
if IsFocused <> ADefault then
IsFocused := ADefault;
end;

procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem);
var
RC: TRect;
Flags: Longint;
State: TButtonState;
IsDown, IsDefault: Boolean;
DrawItemStruct: TDrawItemStruct;
begin
DrawItemStruct := Message.DrawItemStruct^;
FCanvas.Handle := DrawItemStruct.HDC;
RC := ClientRect;
with DrawItemStruct do
begin
IsDown := ItemState and ODS_SELECTED <> 0;
IsDefault := ItemState and ODS_FOCUS <> 0;
if not Enabled then
State := bsDisabled
else if IsDown then
State := bsDown
else
State := bsUp;
end;
Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
if IsDown then
Flags := Flags or DFCS_PUSHED;
if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then
Flags := Flags or DFCS_INACTIVE;
if IsFocused or IsDefault then
begin
FCanvas.Pen.Color := clWindowFrame;
FCanvas.Pen.Width := 1;
FCanvas.Brush.Style := bsClear;
FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
InflateRect(RC, -1, -1);
end;
if IsDown then
begin
FCanvas.Pen.Color := clBtnShadow;
FCanvas.Pen.Width := 1;
FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom);
InflateRect(RC, -1, -1);
if F3DFrame then
begin
FCanvas.Pen.Color := FButtonColor;
FCanvas.Pen.Width := 1;
DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
end;
end
else
DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags);
FCanvas.Brush.Color := FButtonColor;
FCanvas.FillRect(RC);
InflateRect(RC, 1, 1);
if IsFocused then
begin
RC := ClientRect;
InflateRect(RC, -1, -1);
end;
FCanvas.Font := Self.Font;
if IsDown then
OffsetRect(RC, 1, 1);
DrawButtonText(Caption, RC, State, 0);
if IsFocused and IsDefault then
begin
RC := ClientRect;
InflateRect(RC, -4, -4);
FCanvas.Pen.Color := clWindowFrame;
Windows.DrawFocusRect(FCanvas.Handle, RC);
end;
FCanvas.Handle := 0;
end;

procedure TColorBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect;
BiDiFlags: Integer);
var
TB: TRect;
TS, TP: TPoint;
begin
with FCanvas do
begin
TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom);
DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or
BiDiFlags);
TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top);
TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2;
TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2;
OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top);
TRC := TB;
end;
end;

procedure TColorBtn.DrawButtonText(const Caption: string; TRC: TRect; State:
TButtonState; BiDiFlags: Integer);
begin
with FCanvas do
begin
CalcuateTextPosition(Caption, TRC, BiDiFlags);
Brush.Style := bsClear;
if State = bsDisabled then
begin
OffsetRect(TRC, 1, 1);
Font.Color := clBtnHighlight;
DrawText(Handle, PChar(Caption), Length(Caption), TRC,
DT_CENTER or DT_VCENTER or BiDiFlags);
OffsetRect(TRC, -1, -1);
Font.Color := clBtnShadow;
DrawText(Handle, PChar(Caption), Length(Caption), TRC,
DT_CENTER or DT_VCENTER or BiDiFlags);
end
else
DrawText(Handle, PChar(Caption), Length(Caption), TRC,
DT_CENTER or DT_VCENTER or BiDiFlags);
end;
end;

procedure Register;
begin
RegisterComponents('Controls', [TColorBtn]);
end;

end.

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

2. [Отвечает: sattar, 24.10.2005 21:46: Bitbtn1.Caption:='Delphi'#13'C++'#13'Python';

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

3. [Отвечает: dasha ermakova, 30.10.2005 01:08]: Поставь WordWrap = true. Потом пишешь букву, после нее ставишь пробелы, пока курсор не перейдет на новую строку, и так каждый символ.

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


Вопрос #175:
Имеется текстовый файл, кодировка - ANSI. Как его перекодировать в Юникод? Заранее спасибо.

1. [Отвечает: Садовников Владимир, 23.10.2005 22:43]: Начни со следующего:

var
S:string;
UniString:WideString;
begin
S:='Привет Всем! ANSI->Unicode';
UniString:=S; //ANSI->Unicode
end;

А дальше всё по старинке: читаешь из файла, пишешь в файл, читаешь, пишешь и т.д.

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

Вопрос #177:
Привет народ... К вам такой вопросик, может кто знает или встречался с таким, короче нужна помощь... Суть моей проблемы такова. Я разрабатываю программу-каталог с наименованием товара, с подключаемыми файлами, в которых находится только один товар и все с ним связано: в смысле, я беру DLL в котором фотки этого товара и какое-то описание, лучше всего в txt, но вот тут меня берут смятения, как лучше, или базу данных или то, что я задумал? Вообще-то я задумал якобы в одном файле под названием определенного товара лежат jpg`шки и txt`шки о товаре, мысль состоит в том, чтобы на форме имелся список всех этих dll`ок и при нажатии на данным товаром на форме выводились фотки и описание из dll (jpg и txt находятся в dll файлах). Короче, нужно, чтобы delphi их отображал на форме... Если у кого есть другие варианты решения этого трабла, плиииз помогите и поделитесь мыслёй...

1. [Отвечает: Антон Трапезников, 25.10.2005 10:34]: Здравствуйте, PWL. Мне кажется, что Вам нужно написать БД с blob-полем, В котором вы будете сохранять ваши jpeg-и. Например,

Uses jpeg


if Picture.Graphic is TJPegImage then
begin
bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
Picture.Graphic.SaveToStream(bs);
bs.Free;
end
else if Picture.Graphic is TBitmap then
begin
Jpg:=TJPegImage.Create;
Jpg.CompressionQuality:=...;
Jpg.PixelFormat:=...;
Jpg.Assign(Picture.Graphic);
Jpg.JPEGNeeded;
bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
Jpg.SaveToStream(bs);
bs.Free;
Jpg.Free;
end
else
Field.Clear;

Базу данных будет намного проще сопровождать и обслуживать. Переносимость у БД намного выше, чем у Вашего метода, к тому же, нет никаких проблем с такими аспектами как добавление новых данных/защита/целостность и т.д. (в Вашем варианте за это отвечаете Вы, а в случае с БД – технология доступа к данным, например, BDE). Удачи!

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

2. [Отвечает: mvp, 27.10.2005 02:32]: Можно и в форме DLL. Если обеспечить некоторую универсальность, то программа будет опладать эдаким свойством плагиновости. Т. е. без перекомпиляции кода, добавлением одной лишь DLL программа её узнаёт и работает. Идея такова - найти все dll в нужном каталоге. У каждой Вашей DLL должна быть функция, например, getInfo, которая возвращает описание dll, например в текстовом виде. Ещё она должна имень функции, которые возвращают нужную Вам информации. Для ещё более универсальности, их имена тоже могут быть переданы в getInfo. Я делаю так:

handles : array of integer;

var
SR : TSearchRec;
FindRes : boolean;
_ : integer;
InfoFun : function : TStrings; stdcall;
info : TStrings;
InstFun : function : Strings; stdcall;
begin
setLength(handles, 0);
FindRes := FindFirst(ExtractfileDir(paramStr(0)) + '\*.dll', faAnyFile,
SR) = 0;
While FindRes do
begin
if SR.Attr and faDirectory = faDirectory then
begin
FindRes := FindNext(SR) = 0;
Continue
end;
_:= length(handles); {запоминаем хендлы библиотек};
SetLength(handles, _ + 1);
handles[_] := LoadLibrary(pchar(sr.Name));
if handles[_] > 32 then
begin
@infoFun := nil;
@infoFun := GetProcAddress(handles[_], 'GetInfo');
if @infoFun <> nil then
begin
info := InfoFun; //получили информацию
if info <> nil then
begin
InstStr := pchar(info.values['Get Product Function']); //имя функции,
которая вернёт
// описание товара
if instStr = '' then
begin
FreeLibrary(handles[_]); нет такой функции, значит dll не наша и она
нам не нужна
SetLength(handles, _);
FindRes:= FindNext(SR) = 0;
continue
end;
//ну и так далее для остальных нужных функций
end
else
begin
//функция описания DLL ничего не возвратила - она не наша
FreeLibrary(handles[_]);
SetLength(handles, _);
FindRes:= FindNext(SR) = 0;
continue
end
end
else
begin
//Dll не наша, т. к. нет функции getInfo
end;
end
FindRes:= FindNext(SR) = 0
end;

В DLL функция выглядит примерно так:
function GetInfo : TStrings; stdcall;
begin
Result := TStringList.Create;
Result.Add('Get Product Function=GetProduct');//тут внимательно - НЕ
ставьте пробелы перед и после =
//....
end;

function GetProduct:String; stdcall;
begin
//...
end;
//...
exports GetInfo, GetProduct,...

Можно конечно и с БД, но лично я выбрал бы этот вариант, т. к. являюсь противником всех этих глючных БД, а кроме того ещё мало ли какие файлы (компоненты для работы с БД) нужно будет с БД таскать, чтобы запустить на другой машине

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

3. [Отвечает: dasha ermakova, 30.10.2005 01:11]: Все эти данные можно хранить в одной таблице. Просто нужно установить нужный тип поля. Например, для картинок ftGraphic, для текста ftString. А потом отображать их с помощью компонентов из Data Controls.
Сохранять например так:

Table1.Edit;
Table1.Fields[0].Assign(Image1.Picture.Graphic);
Table1.Fields[1].AsString:='Hello';

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


Вопрос #178:
Я хотел бы узнать, как из буфера обмена, в котором находится рисунок в jpeg формате, вставлять его в компонент TImage?

1. [Отвечает: halk2, 23.10.2005 20:58]: Пример из справки:

procedure TForm1.Button1Click(Sender: TObject);
var
Bitmap : TBitmap;
begin
Bitmap := TBitMap.create;
try
Bitmap.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
Image1.Canvas.draw(0,0,Bitmap);
finally
Bitmap.free;
end;
end;

Примечание: Для работы необходимо подключить модуль - ClipBrd.

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

2. [Отвечает: Матвеев И.В,, 24.10.2005 13:39]: Я не знаю, что вы имеете ввиду под словами:
>> как из буфера обмена, в котором находится рисунок в jpeg формате,
>> вставлять его в компонент TImage?
но когда я копирую область JPEG изображения из IrfanView, я могу вставить его в TImage следующим образом:

Image1.Picture.Bitmap.LoadFromClipboardFormat(CF_BITMAP, ClipBoard.GetAsHandle(CF_BITMAP), 0);

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

3. [Отвечает: dasha ermakova, 30.10.2005 01:12]: Насчет jpeg формата не знаю, но рисунок из буфера (например, скриншот) можно загрузить так:
Image1.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.Get AsHandle(cf_Bitmap),0);

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


Вопрос #179:
Есть массив, описывающий введенный алгоритм в виде записей вершина(имя),связи(TStringList имена связанных с ней вершин). Так вот, очень бы хотелось увидеть процедуру разбора такого алгоритма, а точнее выявление всех путей между операторными вершинами. Заранее благодарен.

1. [Отвечает: Садовников Владимир, 23.10.2005 23:13]: Это можно Сделать так (словесная алгоритмическая формулировка):

1. Создаёшь функцию получения адреса записи вершины по её имени.
2. Создаёшь TStringList - список пройденных вершин.
3. Создаёшь функцию, определяющую, есть ли в списке пройденных вершин указанное имя вершины.
4. Запускаешь цикл по всем вершинам (пункт назначения) и искомой (стартовый пункт).
5. Организуешь функцию рекурсии:
a. Функция рекурсии получает два аргумента - текущая вершина, конечная
вершина.
б. При входе в рекурсию функция проверяет, есть ли уже текущая вершина в списке вершин. Если есть - получилась петля, выходим из функции.
в. Функция добавляет в конец списка пройденных вершин имя текущей
вершины.
г. Функция смотрит по очереди каждую вершину-соседа текущей вершины.
Если вершина-сосед - пункт назначения, то список пройденных вершин
есть один из путей без пункта назначения (*** его можно добавить в общий
список путей), иначе функция вызывает саму себя, куда передаёт в
качестве аргумента текущего соседа текущей вершины и пункт назначения.
д. Функция при выходе удаляет из конца списка имя текущей вершины,
если был выполнен пункт (в).
6. Вызываешь функцию рекурсии, которой передаёшь точку (точки) отправления и пункт (пункты) назначения. После этого, если в алгоритме присутствует (***), то смотришь список путей.

Совет: вместо имён лучше использовать указатели - это уменьшит время обработки данных, так как не придётся заниматься постоянным сравнением строк, и пункт 1 отпадает, а пункты 2 и 3 переделываются подуказатели.

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

2. [Отвечает: mvp, 27.10.2005 03:02]: Вы бы привели всё-таки запись, объясняющую, как что записывается. Предположу следующее: имеется запись:

rec1 = record
name : String;
associated : TStrings
end;

Массив таких записей вы и храните (предположение :)) Что значит операторная вершина? Не совсем понятно. Если вы хотите построить граф, то примерно так (используется матрица инцедентности):

var ver: array of rec1;
matrix: array of array of boolean;
//

procedure FindIt;
var _, __, i :integer;
begin
SetLength(Matrix, length(ver));
for _:= 0 to length(ver) - 1 do setLength(Matrix[_], length(ver));
for _:= 0 to length(ver) - 1 do for __:= 0 to length(ver - 1) do
matrix[_][__] := false;
for _:= 0 to length(ver) - 1 do for __:= 0 to ver[_].associated.count - 1
do
for i := 0 to length(ver) - 1 do
if lowercase(ver[i].name) = lowercase(ver[_].associated[__]) then
begin
matrix[_][i] := true;
break
end

end;

Таким образом мы получили матрицу инцедентности графа. Если matrix[i][j] = true, то существует путь длины один из i в j. Но это вам видимо не подходит. Но из неё можно легко узнать путь, если таковой существует, к другой вершине.

type RIsRoadResult = record
yes : boolean;
ins : array of integer;

function IsRoad(i : integer; j : integer) : RIsRoadResult;
var
_, __: integer;
temp : RIsRoadResult;

begin
Result.yes := false;
setLength(result.ins, 0);
if matrix[i][j] then
begin
setLength(result.ins, 1);
result.ins[0] := j;
result.yes := true
end
else for _:= 0 to length(matrix[i]) - 1 if matrix[i][_] then
begin
temp := isRoad(_, j);
if temp.yes then
begin
setLength(Result.ins, Length(result.ins) + length(temp.ins))
for __:= 0 to length(temp.ins) - 1 do Result.ins[length(result.ins) -
length(temp.ins) + __] := temp.ins[__];
SetLength(temp.ins, 0);
result.yes := true;
break
end;

end;
end;

Здесь не учитывается, что возможны циклы, но и это можно поправить. А в общем, это задача поиска пути. Я набросал схему упрощённую. Читайте литературу (того же Кнута) по поиску на графе.

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

3. [Отвечает: dasha ermakova, 01.11.2005 01:54]: Я думаю, что сохранять имена связанных вершин удобнее в массиве символов. Смысл в том, что после нахождения связанной вершины, процедура поиска вызывается рекурсивно уже для новой вершины, сохраняя все пройденные, и так, пока не находим конечную точку. Тогда заносим найденный путь в массив.

ver = record
  v: char;
  con: array of char;
end;

type
  charAr= array of char;

var
  Form1: TForm1;
  Graph: array of ver;
  Path: array of charAr;
  BegP, EndP: char;

implementation

{$R *.dfm}

procedure FindDot(Old: charAr);
var
i, j, num: integer;
found: bool;
Old2: charAr;
begin
  for i:=0 to High(Graph) do
  if Graph[i].v = Old[High(Old)] then
  num:=i;

  for i:=0 to High(Graph[num].con) do
  begin
  found:=false;
    for j:=0 to High(Old)-1 do
    if Graph[num].con[i] = Old[j] then
    begin
    found:=true;
    break;
    end;

    if found = false then
    begin
    Old2:=Old;
    SetLength(Old2,Length(Old)+1);
    Old2[High(Old2)]:=Graph[num].con[i];
      if Graph[num].con[i] <> EndP then
      FindDot(Old2)
      else
      begin
      SetLength(Path,Length(Path)+1);
      Path[High(Path)]:=Old2;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Ar: charAr;
i, j: integer;
begin
SetLength(Path,0);
BegP:=Edit1.Text[1];
EndP:=Edit2.Text[1];
SetLength(Ar,1);
Ar[0]:=BegP;
FindDot(Ar);
ListBox1.Clear;
  for i:=0 to High(Path) do
  begin
  ListBox1.Items.Add('');
    for j:=0 to High(Path[i]) do
    ListBox1.Items[ListBox1.Count-1]:=
    ListBox1.Items[ListBox1.Count-1]+Path[i,j];
  end;
end;

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


Все вопросы и ответы на них Вы всегда можете найти на нашем сайте в разделе "Эксперт": http://www.delphi.int.ru/modules/expert/.


Статья по Delphi.

Из-за технических проблем новых статей нет.


Присылайте свои статьи по адресу info@delphi.int.ru с темой 'Articles' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки и на сайте. Также вы можете заполнить вот эту форму. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).


Файловый архив.

Из данного раздела Вы можете скачать различные файлы: компоненты, plug-in'ы для Delphi, документацию по программированию, программы, игры, написанные на Delphi и всё остальное... Вы можете добавить свои файлы в данный раздел. Чтобы сделать это, пожалуйста, заполните форму на сайте. Новые файлы на сайте:

Название / описание файла
Категория
Объём
Ссылки
 

Чтобы перейти к разделу "Файловый архив" на сайте, нажмите на эту ссылку.


Дружественные сайты.

Здесь представлены ссылки на дружественные сайты нашего портала. Если вы тоже хотите стать нашим другом, разместите наш баннер на своём сайте. Подробнее о том, как это сделать, можно прочитать на странице данного раздела на нашем сайте. Узнать о всех наших друзьях более подробно вы сможете на той же странице...


http://infomania2004.webhost.ru/ - Этот сайт создан для того, чтобы вы могли получить интересующую вас информацию с минимальными затратами сил и времени. Если вы не нашли здесь нужной информации, вы можете оставить заявку на ее поиск. Как только информация будет найдена, она появится на сайте, а вам сообщат об этом.


http://www.visualbasic.noka.ru/ - Программирование на Visual Basic & Basic. На сайте Вы найдете множество примеров, статьи, исходники, ActiveX, а также многое другое!


http://www.sashook.hut1.ru/ - Игры, коллекция флешек, обои и заставки, компьютерные приколы, картинки, тосты и алкогольные присказки, смешные истории и анекдоты.


http://www.ssgroup.fatal.ru/ - Delphi 39. Ресурс для программистов. Статьи, исходники, компоненты, учебники, справочники, FAQ, программы и многое другое.


http://www.hkdsoft.narod.ru/ - H.K.D. Soft - Программирование на Delphi, C/C++, Assembler, Pascal, Basic/VB/VBA/VBS. Компоненты, статьи, исходники, множество е-книг, форум. Бесплатный софт. Скачать программу GamesBase - базу данных по играм содержащую описания, скриншоты, коды, прохождения игр.


Дружественные рассылки:

Рассылки Subscribe.Ru :: Программирование
Интернет для Delphi-программиста
X-Program ПО, новости сайта и программирование в Delphi7
Visual Basic для новичков и профессионалов
Поиск текстов, переводов и аккордов песен
   

 


Юмор.

Училка сынку программера:
- Ты чего в словосочетании "Дубовая роща", в конце слова "роща" через "я" написал? А, ну-ка на доске 20 раз правильно напиши, чтобы на всю жизнь запомнил!
Через минуту поворачивается и видит:
@Reрeat("роща"; 20)

:))

Модем с бодуна снимает трубку:- Гав! Мяяуууу.. Каррр! Тьфу, пи-и-и-и-и-...

:))

Микрософт поделят на три части, а Билла Гейтса клонируют, так что у каждого мелкого MS будет свой Гейтс...

:))

Внимание, новый бесплатный интеpнет-пpовайдеp!
Телефон - 02. Голосовая pегистpация:
Логин: "Менты"
Паpоль: "Козлы"
Специально обyченные пpофессионалы выедyт на место и пpопишyт вам как пеpвичный, так и втоpичный DNS по самое "нехочy"...

:))

У жены программиста спросили:
- А как он за тобой ухаживал?
Жена, после минутного раздумья:
- Компьютер показал...

:))

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

:))

- Алло! Барышня! Соедините меня с моей женой.
- Какой номер?
- Вы что думаете я шах, и жены у меня пронумерованы?!

Анекдоты прислал: Масалов Андрей.


Пожалуйста, присылайте свои анекдоты по этой ссылке: info@delphi.int.ru и они обязательно будут опубликованы! Желательно на компьютерную тему.

Товарищи программисты! Проявляйте свою активность. Давайте помогать друг другу!
Если вы не нашли ответа на свой вопрос, не отчаивайтесь! Количество подписчиков постоянно растёт и, наверняка, найдётся тот человек,
который поможет вам! На сегодня всё. До встречи через неделю!
Ведущий рассылки, Ерёмин Андрей.

Вы можете оказать помощь нашему проекту через систему WebMoney: R379291065219, Z165075684614. Будем очень признательны!

 

Subscribe.Ru
Поддержка подписчиков
Другие рассылки этой тематики
Другие рассылки этого автора
Подписан адрес:
Код этой рассылки: comp.soft.prog.delphifaq
Архив рассылки
Отписаться
Вспомнить пароль

В избранное