Forums.Avtograd.Ru: Вопросы По Delphi, Pascal - Forums.Avtograd.Ru

Перейти к содержимому

  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Вопросы По Delphi, Pascal

#1 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 13:22

Сабж :rolleyes:
0


  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Другие ответы в этой теме

#101 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Февраль 2008 - 11:21

Просмотр сообщенияAdministr (11.2.2008, 22:10):

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

PromptForFileName. не знаю, есть ли в восьмой.
0

#102 Пользователь офлайн   Гаруспик

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 286
  • Регистрация: 28 Ноябрь 07

Отправлено 12 Февраль 2008 - 20:00

Как привязать форму к правому верхнему углу экрана, без изменения ее размеров?
Transgrediaris cadaver proprium!
0

#103 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Февраль 2008 - 20:20

Top := 0;
Left := 0;
0

#104 Пользователь офлайн   Гаруспик

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 286
  • Регистрация: 28 Ноябрь 07

Отправлено 12 Февраль 2008 - 20:22

К правому. )
Transgrediaris cadaver proprium!
0

#105 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Февраль 2008 - 20:25

а скачать делфи ворлд и не задовать тупых вапросов?

пс щас гляну...
0

#106 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 12 Февраль 2008 - 20:27

вот код для залипания к краям экрана, думаю разберёшься)

type
  TARPForm = class(TForm)
  private
	procedure WMWindowPosChanging(var Msg: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  end;

procedure TARPForm.WMWindowPosChanging(var Msg: TWMWindowPosChanging);
var
  rWorkArea: TRect;
  StickAt : Word;
  Docked: Boolean;
begin
  Docked := False;
  StickAt := 10;

  SystemParametersInfo(SPI_GETWORKAREA, 0, @rWorkArea, 0);

  with Msg.WindowPos^ do
  begin
	if x <= rWorkArea.Left + StickAt then begin
	  x := rWorkArea.Left;
	  Docked := TRUE;
	end;

	if x + cx >= rWorkArea.Right - StickAt then begin
	  x := rWorkArea.Right - cx;
	  Docked := TRUE;
	end;

	if y <= rWorkArea.Top + StickAt then begin
	  y := rWorkArea.Top;
	  Docked := TRUE;
	end;

	if y + cy >= rWorkArea.Bottom - StickAt then begin
	  y := rWorkArea.Bottom - cy;
	  Docked := TRUE;
	end;

	if Docked then
	begin
	  with rWorkArea do
	  begin
		// не должна вылезать за пределы экрана
		if x < Left then
		  x := Left;
		if x + cx > Right then
		  x := Right - cx;
		if y < Top then
		  y := Top;
		if y + cy > Bottom then
		  y := Bottom - cy;
	  end; {ширина rWorkArea}
	end;
  end; {с Msg.WindowPos^}

  inherited;
end;

0

#107 Пользователь офлайн   Seraf

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 3 909
  • Регистрация: 01 Ноябрь 07

Отправлено 13 Февраль 2008 - 21:28

тока не ругайтеся - помогите загрузить базу с sql на делфи, как показывать данные из нескольких таблиц сразу в одном окне вывода инфы? Спасибо
древние казахи не знали о существовании евреев и поэтому во всех своих бедах винили тёмные силы
0

#108 Пользователь офлайн   musashi

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 573
  • Регистрация: 01 Ноябрь 07

Отправлено 14 Февраль 2008 - 08:03

Просмотр сообщенияSeraf (13.2.2008, 21:28):

тока не ругайтеся - помогите загрузить базу с sql на делфи, как показывать данные из нескольких таблиц сразу в одном окне вывода инфы? Спасибо

да, вопрос кривой, но цель понятна

какая база?
0

#109 Пользователь офлайн   Saray

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 2 388
  • Регистрация: 31 Январь 08

Отправлено 14 Февраль 2008 - 09:54

Просмотр сообщенияSeraf (13.2.2008, 21:28):

тока не ругайтеся - помогите загрузить базу с sql на делфи, как показывать данные из нескольких таблиц сразу в одном окне вывода инфы? Спасибо

Данные из любой базы вытаскиваются запросами, в завимости от типа БД используем разные наборы компонент (ADO, BDE, mySQLdb и т.д.).
чтобы вытащить данные из нескольких таблиц надо сделать операцию умножения множеств (таблиц)
"select *
from table1 inner join table2 on (table1.id = table2.param)
inner join table3 on (table1.id = table3.link)"
при умножении множеств каждой строчке первой таблицы сопоставляется все строки второй, то есть если в первой 10 строк, во второй 100, то получится временная таблица 10 х 100 = 1000 строк, потом вся эта масса сопоставляется с каждой строкой третьей таблицы и результат может получиться очень большим, по этому сопоставляются только те строки, которые удовлетовряют условиям (в скобках).
результат запроса - тоже таблица, которую можно отобразить в одном окне
Если женщина не права, нужно извиниться и замолчать.
0

#110 Пользователь офлайн   musashi

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 573
  • Регистрация: 01 Ноябрь 07

Отправлено 14 Февраль 2008 - 18:46

Просмотр сообщенияSaray (14.2.2008, 9:54):

...

твой ответ звучит несколько надуманно!
парню явно необходимы элементарные выборки!
0

#111 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 14 Февраль 2008 - 19:33

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

кароче что надо, или что должно быть в примере:
1) создание бд с нуля в программе средствами кода, это надо для создания пустой бд на компе пользователя.
2) занос записей в эту бд программыными средствами из строк, то есть без визуальных компанетов таблиц бд
3) выборка из базы данных по запорсу с получением результаата в такой форме, чтобы каждую полученную запись можно было обработать допустим в цикле for или while
4) чтобы нинадо было с собой таскать никаких библиотек типа бде или тому подобных, это наверно адо надо или ещё чего, я не знаю...
5) спасибо)
0

#112 Пользователь офлайн   Saray

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 2 388
  • Регистрация: 31 Январь 08

Отправлено 15 Февраль 2008 - 10:24

Просмотр сообщенияup (14.2.2008, 19:33):

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

в винде нету встроенных нормальных СУБД (за исключением кривого аналога БДЕ который тоже работает с DBF),
так что необходимо определиться с задачами и выбрать СУБД, рекомендую firebird (бесплатный аналог interbase)
или же можно найти бесплатную обрезанную версию MS SQL 7.0 (для чего бесплатную надеюсь объяснять не надо)
Обе работают через стандартные компоненты дельфи, ничего лишнего в систему ставить не надо, только саму СУБД на сервер.

все остальное делается с помощью запросов через компонент Query:

Просмотр сообщенияup (14.2.2008, 19:33):

1) создание бд с нуля в программе средствами кода, это надо для создания пустой бд на компе пользователя.

вобщето обычно переписывают и подключают "болванку" сразу после установки движка СУБД, но если хочется с нуля создавать заново:
create table traff (
ats varchar(15) not null,
dt datetime not null,
route varchar(16) not null,
traff decimal(16,2)
)

create index traf_idx on traff (
dt,
route
)

Просмотр сообщенияup (14.2.2008, 19:33):

2) занос записей в эту бд программыными средствами из строк, то есть без визуальных компанетов таблиц бд

insert into traff (ats,td,route,traff) values
('MTT','2008-02-15 09:00:00','MTTO',16.2)

Просмотр сообщенияup (14.2.2008, 19:33):

3) выборка из базы данных по запорсу с получением результаата в такой форме, чтобы каждую полученную запись можно было обработать допустим в цикле for или while


пишешь себе модуль :
unit FetchValues;
interface
uses Windows, Messages, SysUtils, Classes, ADODB, DB;

type
TFetchValues = class
ST, ST2 : longint;
Names : TStringList;
Vals : array of TStringList;
Count : integer;
FCount : integer;
constructor Create( Query : TADOQuery ); // выполнить запрос
destructor Die;
function GetTag( TagName : string; Index : integer ) : string; // вытащить значение название столбца, строка
function GetCol( ColNum : integer; Index : integer ) : string; // вытащить значение столбец, строка
function FbToIso( dDate : string ) : string; // конвертация даты
end;

implementation

function TFetchValues.FbToIso(dDate: string): string;
begin
if Length(dDate) = 19 then
Result := copy(dDate,7,4) + '-' + copy(dDate,4,2) + '-' + copy(dDate,1,2) +
copy(dDate,11,9);
if Length(dDate) = 18 then
Result := copy(dDate,7,4) + '-' + copy(dDate,4,2) + '-' + copy(dDate,1,2) +
' 0'+copy(dDate,12,7);
if Length(dDate) = 10 then
Result := copy(dDate,7,4) + '-' + copy(dDate,4,2) + '-' + copy(dDate,1,2);
end;

constructor TFetchValues.Create(Query: TADOQuery);
var
i, j : integer;
tag : string;
iserror : boolean;
begin
if Query = nil then exit;
if Query.Active = true then
begin
Names := TStringList.Create;
SetLength( Vals, 0 );
exit;
end;

ST := GetTickCount;

iserror := false;
try
Query.Active := true;
Count := Query.recordcount;
FCount := 0;
if Count > 0 then
FCount := Query.Fields.Count;

if Count > 0 then Query.First;

ST2 := GetTickCount;

except
on E: Exception do
begin
iserror := true;
fmMain.DisplayMessage('====Ошибка=====');
fmMain.DisplayMessage( E.Message );
fmMain.DisplayMessage('===============');
fmMain.DisplayMessage( string(Query.SQL.GetText) );

if E.Message = 'Ошибка подключения' then
begin
Query.Connection.Connected := false;
Sleep(5000);
Query.Connection.Connected := true;

end;
end;
end;

if (fmMain.DebugMode) and ( not iserror ) then
begin
fmMain.DisplayMessage( string(Query.SQL.GetText) );
fmMain.DisplayMessage('--------- '+IntToStr(ST2-ST)+' ---------'); //записываем время выполнения запроса
end;

Names := TStringList.Create;
SetLength( Vals, Query.Fields.Count );
for i := 0 to FCount-1 do
begin
Vals[i] := TStringList.Create;
tag := LowerCase( Query.Fields.Fields[i].DisplayName );
Names.Add( tag );
end;

for j := 0 to Count-1 do
begin
for i := 0 to FCount-1 do
begin
if not Query.Fields.Fields[i].IsBlob then
Vals[i].Add( Query.Fields.Fields[i].DisplayText )
else
Vals[i].Add(TBlobField(Query.Fields.Fields[i]).AsString );
end;
if j < count-1 then Query.Next;
end;

Query.Active := false;
end;

destructor TFetchValues.Die;
var
i : integer;
begin
if Assigned(Names) then Names.Free;
for i := 0 to FCount-1 do
if Assigned(Vals[i]) then
Vals[i].Free;
SetLength( Vals, 0 );
end;


function TFetchValues.GetCol(ColNum, Index: integer): string;
var
ss : string;
ch : integer;
begin
Result := '';
if Index < 0 then exit;
if ColNum >= FCount then exit;
if Index >= Vals[ColNum].Count then exit;
Result := Vals[ColNum].Strings[Index];

if ((Length(Result) = 19) or (Length(Result) = 18) or (Length(Result) = 10)) then
if (Result[3] = '.') and (Result[6] = '.') then
begin
ch := 0;
ss := copy(Result,7,4);
try
ch := StrToInt( ss );
except
end; //try
if (ch > 1000) and (ch < 3000) then
Result := FbToIso( Result );
end;

end;

function TFetchValues.GetTag(TagName: string; Index: integer): string;
var
i : integer;
ss : string;
ch : integer;
begin
Result := '';
if Index < 0 then exit;
for i := 0 to FCount-1 do
if Names[i] = TagName then
begin
if Index >= Vals[i].Count then exit;
Result := Vals[i].Strings[Index];

if ((Length(Result) = 19) or (Length(Result) = 18) or (Length(Result) = 10)) then
if (Result[3] = '.') and (Result[6] = '.') then
begin
ch := 0;
ss := copy(Result,7,4);
try
ch := StrToInt( ss );
except
end; //try
if (ch > 1000) and (ch < 3000) then
Result := FbToIso( Result );
end;

break;
end;
end;
end.


а потом используешь в своем коде:

var
fv : TFetchValues;
...

Q.SQL.Clear;
Q.SQL.ADD('select route, traff from traff');
Q.SQL.ADD('where dt >= '#39+dt+#39);

fv := TFetchValues.Create(Q);
for i := 0 to fv.Count-1 do
Memo1.Lines.Add(fv.getcol(0,i)+' = '+fv.gettag('traff',i));
fv.die;

достаточно удобно для мелких проектов )
если интересно могу выслать мылом парочку интересных примеров как на MS SQL та ки на Firebird
Если женщина не права, нужно извиниться и замолчать.
0

#113 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 12:04

спасибо! =)

высылай на up_tlt (!entodel!) (сабака) mail.ru оба

как я понял, надо эти движки баз данных скачать а потом с собой в програаму их сетап и устонавливать? так? меня интересует та база данных, которая:
1) меьнше весит, если они по 10 мб весят... (((
2) можно использовать в комерческой программе не платя денег разработчикам.
3) да, забыл, мне бд не на сервере нужен, а на локальном компе в программе, я пишу десктопные приложения. щас задача токая, надо держать базу книг электронной диблотеки, так вот их там 11000... со всеми данными и описанием... я сначало хотел всё на списках обектов сделать, а потом думаю это не подходит, собственно на объектах сделал, но это щас работает на несколько сотен книг, а вот если туда все 11000 добавить, то уже и память жрать будет немеренно, и тормоза с запросами...

ещё вопросы по бд:
1) у меня есть допустим список книг, поля: автор, заголовок, цикл, жанр, путь к книге. все резуальтатты должны вернуть все данные о книге тоесть: автор, заголовок, цикл, жанр, путь к книге + то что в пуктах а-в
а) как сделать запрос, чтобы на выходе был список допустим писателей без поватарения
б) список циклов определённого писателя без повторений
в) список книг определенного писателя и цикла (ну эт наверно проще)
как я понимаю, нужно для каждого поля связанную таблицу создовать, но как на практике сделать это я не знаю... да ещё потом надо заносить однм запросом данные сразу во все таблицы, это как сделать я тоже не знаю...
2) можно-ли в бд хранить большой объём текста, скажем 10-15 кб для каждой записи?

вот как у меня щас всё это реализованно:
unit iBookDBUnit;

interface

uses
  Windows, Messages, KOL, SysUtils, Variants, Classes, Contnrs, QStrings,
  VBScript_RegExp_55_TLB, OzonUnit;

type
//  PBookItem = ^TBookItem;
  TBookItem = class(TObject)
  private
  public
	function GetInfoImage(var Info: string; var ImgPath: string): Boolean;
  public
	Author: string;
	Title: string;
	Series: string;
	Genre: string;
	FilePath: string;
  end;

  TBooksList = class
  private
	function Get(Index: Integer): TBookItem;
	function GetCount: Integer;
	procedure AddBook(AAuthor, ATitle, ASeries, AGenre, AFilePath{, AImgPath, AInfoPath}: string);	
  protected
	FBooksList: TObjectList;
  public
	constructor Create;// override;
	destructor Destroy; override;
  public
	property Count: Integer read GetCount;
	property Items[Index: Integer]: TBookItem read Get{ write Put}; default;
	procedure Clear;
	function FindBooks(AAuthor, ATitle, ASeries, AGenre: string; var AResult: TBooksList): Boolean;
	function FunnelBook(AAuthor, ATitle, ASeries, AGenre: string; var AResult: TStringList): Boolean;
	procedure AddEBook(ARoot, AFilePath: string);	
  end;

  TBooksFinder = class(TBooksList)
  private
  public
	constructor Create; //override;
	destructor Destroy; override;
  end;

function GetBookAuthor(Text: string): string;
function GetBookTitle(Text: string): string;  

var
  InfoImgDir: string;

implementation

uses StrUtils;

function GetBookAuthor(Text: string): string;
begin
  Result := Q_GetWordN(1, Text, '-—');
  Q_TrimInPlace(Result);
  if Q_IsEmptyStr(Q_GetWordN(2, Text, '-')) then Result := '';
end;

function GetBookTitle(Text: string): string;
begin
  Result := Q_GetWordN(2, Text, '-—');
  if Q_IsEmptyStr(Result) then Result := Text;
  Q_TrimInPlace(Result);
end;

function TestGetBookDescr(Root, Path, Mask: string; var AAuthor, ATitle, ASeries, AGenre: string): Boolean;
type
  TSubMat = record
	Name: string;
	Value: string;
  end;
var
  R: RegExp;
  RegExprMask: string;
  mc: MatchCollection;
  m: Match;
  sm: SubMatches;
  i, j: Integer;
  Mats: array of TSubMat;
  ResultInt: Boolean;
begin
  Result := False;
  ResultInt := False;
  Q_DeleteText(Path, Root);

  if Q_CountOfWords(Path, '\') <> Q_CountOfWords(Mask, '\') then exit;
//  if Q_CountOfWords(Path, '-') <> Q_CountOfWords(Mask, '-') then exit;  

  R := CoRegExp.Create;
  try
	R.IgnoreCase := True;
	R.Global := True;
	R.Multiline := True;
	R.Pattern := '\[(\w*)\]';
	RegExprMask := R.Replace(Mask, '(.*)');
	R.Pattern := '\\';
	RegExprMask := R.Replace(RegExprMask, '\\');

//	Form2.Memo5.Lines.Add(RegExprMask);

	R.Pattern := '\[(\w*)\]';
	mc := R.Execute(Mask) as MatchCollection;
	if mc.Count > 0 then begin
	  SetLength(Mats, mc.Count);
	  for i := 0 to mc.Count - 1 do begin
		m := mc[i] as Match;
//		Form2.Memo5.Lines.Add(Format('Match[%d] = "%s"', [i, m.Value]));
		sm := m.SubMatches as SubMatches;
		for j := 0 to sm.Count - 1 do begin
//		  Form2.Memo5.Lines.Add(Format('  SubMatch[%d] = "%s"', [j,VarToStr(sm[j])]));
		  Mats[i].Name := VarToStr(sm[j]);
		  ResultInt := True;
		end;
	  end;
	end;

	if not ResultInt then exit;
	ResultInt := False;


	R.Pattern := RegExprMask+'\.';
	mc := R.Execute(Path) as MatchCollection;
	if mc.Count > 0 then begin
	  for i := 0 to mc.Count - 1 do begin
		m := mc[i] as Match;
//		Form2.Memo5.Lines.Add(Format('Match[%d] = "%s"', [i, m.Value]));
		sm := m.SubMatches as SubMatches;
		for j := 0 to sm.Count - 1 do begin
//		  Form2.Memo5.Lines.Add(Format('  SubMatch[%d] = "%s"', [j,VarToStr(sm[j])]));
		  Mats[j].Value := VarToStr(sm[j]);
		  ResultInt := True;
		end;
	  end;
	end;

	if not ResultInt then exit;

	for i:=0 to Length(Mats) - 1 do begin
	  if SameText(Mats[i].Name, 'author') then AAuthor := Mats[i].Value;
	  if SameText(Mats[i].Name, 'title') then ATitle := Mats[i].Value;
	  if SameText(Mats[i].Name, 'series') then ASeries := Mats[i].Value;
	  if SameText(Mats[i].Name, 'genre') then AGenre := Mats[i].Value;
	end;

	Result := True;

  finally
	R := nil;
  end;
end;

function TestGetBookDescr2(Root, Path: string; var AAuthor, ATitle, ASeries, AGenre: string): Boolean;
var
  Masks: TStringList;
  i: integer;
begin
  Result := False;
  try
	Masks := TStringList.Create;
	Masks.Text := LoadMaskFile('TitleParseMasks.txt');

	for i:=0 to Masks.Count - 1 do begin
	  if TestGetBookDescr(Root, Path, Masks[i], AAuthor, ATitle, ASeries, AGenre) then begin
		Result := True;
		exit;
	  end;
	end;
  finally
	FreeAndNil(Masks);
  end;
end;


{ TBookItem }

function TBookItem.GetInfoImage(var Info: string; var ImgPath: string): Boolean;
begin
  Result := False;
  if FileExists(InfoImgDir+Format('%s - %s.jpg', [Author, Title])) and FileExists(InfoImgDir+Format('%s - %s.txt', [Author, Title])) then begin
	Info := StrLoadFromFile(InfoImgDir+Format('%s - %s.txt', [Author, Title]));
	ImgPath := InfoImgDir+Format('%s - %s.jpg', [Author, Title]);
	Result := True;
  end;
end;

{ TBooksList }

constructor TBooksList.Create;
begin
  FBooksList := TObjectList.Create;
  FBooksList.OwnsObjects := False;
end;

destructor TBooksList.Destroy;
begin
  Clear;
  FreeAndNil(FBooksList);
  inherited;
end;

procedure TBooksList.AddBook(AAuthor, ATitle, ASeries, AGenre, AFilePath{, AImgPath,
  AInfoPath}: string);
var
  Item: TBookItem;
begin
//  New(Item);
//  Initialize(Item^);
  Item := TBookItem.Create;
//  with Item^ do begin
  with Item do begin
	Author := AAuthor;
	Title := ATitle;
	Series := ASeries;
	FilePath := AFilePath;
	Genre := AGenre;
//	ImgPath := AImgPath;
//	InfoPath := AInfoPath;
  end;
  FBooksList.Add(Item);
end;

procedure TBooksList.AddEBook(ARoot, AFilePath: string);
var
  AAuthor, ATitle, ASeries, AGenre: string;
begin
  if TestGetBookDescr2(ARoot, AFilePath, AAuthor, ATitle, ASeries, AGenre) then begin
	AddBook(
	  IfThen(Q_IsEmptyStr(AAuthor), 'Без автора', AAuthor),
	  IfThen(Q_IsEmptyStr(ATitle), 'Без загаловка', ATitle),
	  IfThen(Q_IsEmptyStr(ASeries), 'Без серии', ASeries),
	  IfThen(Q_IsEmptyStr(AGenre), 'Без жанра', AGenre),
	  AFilePath);
  end;
end;

function TBooksList.FindBooks(AAuthor, ATitle, ASeries, AGenre: string;
  var AResult: TBooksList): Boolean;
var
  I: integer;
  Item: TBookItem;
begin
//  Result := False;
  if AResult=nil then AResult := TBooksList.Create else AResult.Clear;
  for I:=0 to Pred(FBooksList.Count) do begin
	Item := FBooksList[I] as TBookItem;
	with Item do begin
	  if Q_TestWildText(Author, AAuthor) and Q_TestWildText(Title, ATitle) and Q_TestWildText(Series, ASeries) and Q_TestWildText(Genre, AGenre) then begin
		AResult.AddBook(Author, Title, Series, Genre, FilePath{, ImgPath, InfoPath});
	  end;
	end;
  end;
  Result := AResult.Count > 0;
end;


function TBooksList.FunnelBook(AAuthor, ATitle, ASeries, AGenre: string;
  var AResult: TStringList): Boolean;
var
  I: integer;
  Item: TBookItem;
  ATempResult, AEmpResult: TBooksList;
  AintResult: Boolean;
begin
  Result := False;
  ATempResult := TBooksList.Create;
  AEmpResult := TBooksList.Create;
  AintResult := False;

  if AResult=nil then AResult := TStringList.Create else AResult.Clear;
  for I:=0 to Pred(FBooksList.Count) do begin
	Item := FBooksList[I] as TBookItem;
	with Item do begin

	  if AAuthor='#' then begin
		AintResult := not ATempResult.FindBooks(Author, '*', '*', '*', AEmpResult);
	  end else begin
		AintResult := Q_TestWildText(Author, AAuthor);
//		AintResult := AintResult and Q_TestWildText(Author, AAuthor);
	  end;

	  if ATitle='#' then begin
		AintResult := (not ATempResult.FindBooks('*', Title, '*', '*', AEmpResult)) and AintResult;
	  end else begin
		AintResult := Q_TestWildText(Title, ATitle) and AintResult;
	  end;

	  if ASeries='#' then begin
		AintResult := (not ATempResult.FindBooks('*', '*', Series, '*', AEmpResult)) and AintResult;
	  end else begin
		AintResult := Q_TestWildText(Series, ASeries) and AintResult;
	  end;

	  if AGenre='#' then begin
		AintResult := (not ATempResult.FindBooks('*', '*', '*', Genre, AEmpResult)) and AintResult;
	  end else begin
		AintResult := Q_TestWildText(Genre, AGenre) and AintResult;
	  end;

	  // в самом конце
	  if AintResult then ATempResult.AddBook(Author, Title, Series, Genre, FilePath);

{	  if  and  and  and  then begin
		ATempResult.AddBook(Author, Title, Series, Genre, FilePath);}
//	  end;
	end; // Item
  end; // for

  if AAuthor='#' then begin
	for i:=0 to ATempResult.Count - 1 do AResult.Add(ATempResult.Items[i].Author);
  end;

  if ATitle='#' then begin
	for i:=0 to ATempResult.Count - 1 do AResult.Add(ATempResult.Items[i].Title);
  end;

  if ASeries='#' then begin
	for i:=0 to ATempResult.Count - 1 do AResult.Add(ATempResult.Items[i].Series);
  end;

  if AGenre='#' then begin
	for i:=0 to ATempResult.Count - 1 do AResult.Add(ATempResult.Items[i].Genre);
  end;

  Result := AResult.Count > 0;
  FreeAndNil(ATempResult);
  FreeAndNil(AEmpResult);
end;

procedure TBooksList.Clear;
var
  I: integer;
  Item: TBookItem;
begin
 for I:=0 to Pred(FBooksList.Count) do begin
	Item := FBooksList[I] as TBookItem;
	FreeAndNil(Item);
//	Finalize(Item^);
//	Dispose(Item);
	end;
  FBooksList.Clear;
end;

function TBooksList.Get(Index: Integer): TBookItem;
begin
  Result := FBooksList[Index] as TBookItem;
end;

function TBooksList.GetCount: Integer;
begin
  Result := FBooksList.Count;
end;


{ TBooksFinder }

constructor TBooksFinder.Create;
begin
  inherited;

end;

destructor TBooksFinder.Destroy;
begin

  inherited;
end;

initialization
  InfoImgDir := GetStartDir + 'Data\';
  CreateDir(InfoImgDir);

end.


а вот как используется, в запрос можно вводить # для исключения дубликотов
например запрос # * * * вернёт список всех авторов

Author=Иоанна Хмелевская
Author=Булгаков
Author=Булгаков Михаил
Author=Зигмунд Фрейд
Author=Стивен Стайн, Говард Бук - Преимущества EQ Эмоциональная культура и ваш успех
Author=Стивен Стайн, Говард Бук
Author=Энтони Берджес
Author=Айзек Азимов
Author=Айзек
Author=Алексей Пехов
Author=Андрей Ливадный
Author=Аркадий и Борис Стругацкие
Author=Кларк Артур
Author=Василий Головачев
Author=Вернор Виндж
Author=Васильев
Author=Васильев Владимир
Author=Владимир Васильев
Author=Гарри Гаррисон
Author=Джон Уиндем
Author=Дэвид Брин
Author=Жюль Верн
Author=Иван Тропов
Author=Лем Станислав
Author=Лем
Author=Макс Фрай
Author=Пауло Коэльо
Author=Алексей Пехов и Андрей Егоров
Author=Дмитрий Глуховский
Author=Желязны Роджер
Author=Любовь ЛУКИНА, Евгений ЛУКИН
Author=Роберт Хайлайн
Author=Сергей Лукьяненко
Author=Уиндем Джон
Author=Роберт Шекли
Author=R.Shekli
Author=Роджер Желязны
Author=Роулинг Джоан Кэтлин
Author=Сергей Козлов
Author=Стивен КИНГ
Author=Умберто Эко


запрос 'Сергей Лукьяненко' * # * вернёт список серий

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JvComponent, JvSearchFiles, iBookDBUnit, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
	SFFindBooks: TJvSearchFiles;
	Label1: TLabel;
	EditAuthor: TEdit;
	Label2: TLabel;
	EditTitle: TEdit;
	Label3: TLabel;
	EditSeries: TEdit;
	Label4: TLabel;
	EditGenre: TEdit;
	Memo1: TMemo;
	Button1: TButton;
	Button2: TButton;
	procedure FormCreate(Sender: TObject);
	procedure FormDestroy(Sender: TObject);
	procedure SFFindBooksFindFile(Sender: TObject; const AName: String);
	procedure Button2Click(Sender: TObject);
	procedure Button1Click(Sender: TObject);
  private
	{ Private declarations }
	BooksList: TBooksList;
  public
	{ Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses QStrings;

procedure TForm1.SFFindBooksFindFile(Sender: TObject; const AName: String);
begin
  BooksList.AddEBook(SFFindBooks.RootDirectory, AName);
end;


procedure TForm1.FormCreate(Sender: TObject);

begin
  BooksList := TBooksList.Create;
//  SFFindBooks.RootDirectory := 'C:\Downloads\Книги\Фантастика\';
  SFFindBooks.RootDirectory := 'C:\Downloads\Книги\';
  SFFindBooks.Search;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(BooksList);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
  Memo1.Clear;
  
  for i:=0 to BooksList.Count - 1 do begin
	with BooksList[i] do begin
	  Memo1.Lines.Add('Author='+Author);
	  Memo1.Lines.Add('Title='+Title);
	  Memo1.Lines.Add('Series='+Series);
	  Memo1.Lines.Add('Genre='+Genre);
	  Memo1.Lines.Add('');
	end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  FunnelResult: TStringList;
begin
  FunnelResult := TStringList.Create;
  Memo1.Clear;

  BooksList.FunnelBook(
	EditAuthor.Text,
	EditTitle.Text,
	EditSeries.Text,
	EditGenre.Text,
	FunnelResult);

  for i:=0 to FunnelResult.Count - 1 do begin
	Memo1.Lines.Add('Author='+FunnelResult[i]);
  end;

  FreeAndNil(FunnelResult);
end;


end.

0

#114 Пользователь офлайн   Saray

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 2 388
  • Регистрация: 31 Январь 08

Отправлено 15 Февраль 2008 - 13:31

Просмотр сообщенияup (15.2.2008, 12:04):

спасибо! =)

высылай на up_tlt (!entodel!) (сабака) mail.ru оба



Классно у тебя на TMemo свой маленький SQL механизм реализован, добавь туда поддержку индексы (индекс - это отсортированный список, или отсортированные ссылки на список, благодаря знанию закономерности расположения данных в списке можно искать гораздо быстрее) и будет классно.

А если серьезно всё это давно написано и называется Система Управления Базами Данных

Для твоих задач рекомендую FireBird 1.5 - FireBird 2.0 как заведомо бесплатный продукт (весит ~3 mb)
под него есть удобная оболочка IBExpert (6 mb)

до дома дойду вышлю)
Если женщина не права, нужно извиниться и замолчать.
0

#115 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 13:38

пасиб! мыло только удали из сваего поста, и так спама немерянно валтиться... (

на остальные вопросы ответь или примеры вышли, я сам врядли разберусь ;)

движок бызы только не надо высылать, сам найду или ссылки дай)
0

#116 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 14:01

так файрбёрд нашёл http://www.firebirdsql.org качаю, у мя анлим 64, так что придётся подождать. там какие ещё файлы качать чтобы поддержка в делфи была? и где взять IBExpert?
0

#117 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 16:32

лазил по торри, нашёл ASQLite3 база данных в виде dll 350 кб. вот это наврено буду использовать. поддерживает подключение к стандартным компанентам. теперь надо примеры как всё это использовать.
0

#118 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 16:56

щас собрал ASQLite3 в статической линковке, надо ASqlite3Null200710A.zip и sqlite_3_3_4_full.zip с сайта http://aducom.com/cen/download.php там надо зарегится чтобы скачать. экзешник вести метр. но это приемлемо, ведь это всё в сетапе упакуется.
0

#119 Пользователь офлайн   musashi

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 573
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 18:55

я готов РУКИ оборвать, тем деятелям которые постять код просто в сообщении!

есть BB-code специальный для этого!

зачем срать?
0

#120 Пользователь офлайн   up

  • Старожил
  • PipPipPipPipPip
  • Группа: Пользователи
  • Сообщений: 1 193
  • Регистрация: 01 Ноябрь 07

Отправлено 15 Февраль 2008 - 19:34

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

ты лучше по сути помоги... помощь она когда надо лишней не бывает =)
0

  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

1 человек читают эту тему
0 пользователей, 1 гостей, 0 скрытых пользователей