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

Бизнес с высокой прибылью

  Все выпуски  

Черный ящик. Эпизод первый: от компьютера - к бизнесу


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

Дополнение к выпуску про структуру данных

После двух последних выпусков получил такие интересные отклики:


Hello Алексей,

  Я по поводу вопроса как писать напрямую в БД. Там вообще проблем
  никаких, легко работает такой объект.

  object Query1: TQuery
    Active = True
    SQL.Strings = (
      'select sum(sum_amount) from kkkkk.db where cli_name=:pr1')
    Left = 224
    Top = 200
    ParamData = <
      item
        DataType = ftString
        Name = 'pr1'
        ParamType = ptUnknown
        Value = 'combobox1.text'
      end>
  end

  И в программе если треба другой запрос

Query1.close;
query1.sql.Clear;
query1.params.Clear;
query1.sql.Add('insert into kkkkk.db ');
query1.sql.Add('(cli_name, calen_date, sum_amount) values (:pr1, :pr2, :pr3)');
query1.params[0].Asstring:=combobox1.text;
query1.params[1].asdate:=datetimepicker1.date;
query1.params[2].asbcd:=strtofloat(edit1.text);
query1.execsql;

  Ну или просто табличка.

  object Table1: TTable
    Active = True
    IndexFieldNames = 'KLIENT'
    TableName = 'kli.db'
    Left = 256
    Top = 65528
  end

  А вообще я уже 2 года пишу через IBX компоненты и разобрался с ними
  достаточно. Сначала конечно проблем много было.

Удачи,
 Anton
mailto:viman@pisem.net


Еще одно письмо с решением:


 Hello!

  В выпуске последнем спрашивали про хранение данных. Типа массив
  записей. Так вот, я писал такую штуку. Только не компонент, а просто
  классик такой. надо?

--
С наилучшими пожеланиями,
   Alexandr Belayev  <
mailto:var_alex@fromru.com>

А> Если эту штуку можно будет поместить в выпуске рассылки
А> а всем желающим - бесплатно использовать, тогда надо.

 Можно. Лови.

 Краткое описание того, что там есть:
 Это класс список записей. Построен на материале известной в инете
 статьи "как использовать шаблоны в DELPHI". Хотя шаблонов там нету.
 Если будут вопросы про работу этого класса, спрашивай.
 Общая идея в том, что в начале модуля определяется запись
TRecord, и из таких записей и состоит список. Структуру записи можно
меня как  угодно. Всё будет правильно работать.

--
С наилучшими пожеланиями,
         Alexandr Belayev  < mailto:var_alex@fromru.com >


unit ListTemplate;
interface
uses windows,sysutils,classes;

type
  TRecord = record
    S:Shortstring;
    c:char;
    v:OleVariant;
  end;
  pRecord = ^TRecord;

  TDATA_TYPE = TRecord;
  pDATA_TYPE = pRecord;

  ERecordListError = class(Exception);

  TArray = array of TDATA_TYPE;

  // Этот класс является ВЛАДЕЛЬЦЕМ записей, то есть он сам их все убивает
  // при своём уничтожении. И нет необходимости убивать каждую запись отдельно.
  TRecordList = class
  private
    fArray:TArray;
    fCount: integer;
    function GetCapacity: integer;
    function GetItem(i: integer): pDATA_TYPE;
    procedure SetCapacity(const Value: integer);
    procedure SetCount(const Value: integer);
    procedure SetItem(i: integer; const Value: pDATA_TYPE);
    procedure Error(const AMessage:string);
    procedure MoveElementsDown(AIndex:integer);
  protected
    function IsRecordsEqual(const AConstRec, AComparedRec:TDATA_TYPE):boolean;virtual;abstract;
    function CompareRec(const AFirst, ASecond:pDATA_TYPE):integer;virtual;abstract;
  public
    constructor Create(ACapacity:integer);overload;
    constructor Create;overload;
    destructor Destroy;override;
    // Добавление новой записи
    function  Add:pDATA_TYPE;
    procedure Delete(index:integer);
// удаляет запись из массива, и сдвигает все записи лишние вниз, что-бы не образовывалось дырки.
    procedure Remove(index:integer; var ARec:TDATA_TYPE); overload; // удаляет ссылку на запись из массива,
    // при этом ptr должен указывать на запись в которую будет скопировано содержимое удаляемой записи.
    procedure Clear;
    property Item[i:integer]:pDATA_TYPE read GetItem write SetItem; default;
    property Count:integer read fCount write SetCount;
    property Capacity:integer read GetCapacity write SetCapacity;
    function IndexOf(const ARecord:TDATA_TYPE):integer;
    property List:TArray read fArray;
    procedure Sort;
  end;

implementation

{ TRecordList }

function TRecordList.Add: pDATA_TYPE;
//var
//  i:integer;
begin
  if Length(fArray) = fCount then
    begin
      SetLength(fArray,fCount+4);
      FillChar(fArray[fCount],(Length(fArray)-fCount)*SizeOf(TDATA_TYPE),0);
//      for i:=fCount to Length(fArray)-1 do
//        FillChar(fArray[i],SizeOf(TDATA_TYPE),0);
    end;
  inc(fCount);
  Result:=@fArray[fCount-1];
end;

constructor TRecordList.Create(ACapacity: integer);
begin
  inherited Create;
  fCount:=0;
  SetLength(fArray, ACapacity);
  if Length(fArray) > 0 then FillChar(fArray[0],SizeOf(TDATA_TYPE)*fCount,0);
end;

procedure TRecordList.Clear;
begin
  fArray:=nil;
  fCount:=0;
end;

constructor TRecordList.Create;
begin
  inherited;
  fCount:=0;
  fArray:=nil;
end;

procedure TRecordList.Delete(index: integer);
begin
  if (index>=fCount) or (index<0) then Error(format('%s - индекс удаляемого элемента (%d) находиться вне необходимых границ (0 -:- %d)',[self.classname,index, fcount]));
  Finalize(fArray[index]);
  MoveElementsDown(index);
  dec(fCount);
end;

destructor TRecordList.Destroy;
begin
  Clear;
  inherited;
end;

procedure TRecordList.Error(const AMessage:string);
begin
  raise ERecordListError.Create(AMessage);
end;

function TRecordList.GetCapacity: integer;
begin
  Result:=Length(fArray);
end;

function TRecordList.GetItem(i: integer): pDATA_TYPE;
begin
  if (i<0) or (i>=fCount) then Error(format('%s - индекс запрашиваемого элемента (%d) находиться вне необходимых границ (0 -:- %d)',[self.classname,i, fcount]));
  Result:=@fArray[i];
end;

function TRecordList.IndexOf(const ARecord: TDATA_TYPE): integer;
var
  i:integer;
begin
  Result:=-1;
  for i:=0 to fCount-1 do
    if IsRecordsEqual(ARecord,fArray[i]) then
      begin
        Result:=i;
        break;
      end;
end;

procedure TRecordList.Remove(index: integer; var ARec: TDATA_TYPE);
begin
  if (index<0) or (index>=fCount) then Error(format('%s - индекс изымаемого элемента (%d) находиться вне необходимых границ (0 -:- %d)',[self.classname,index, fcount]));
  //MoveMemory (@ARec,@fArray[index],SizeOf(TDATA_TYPE));
  ARec:=fArray[index];
  MoveElementsDown(index);
  // FillChar(fArray[fCount-1],SizeOf(TDATA_TYPE),0);
  dec(fCount);
end;

procedure TRecordList.SetCapacity(const Value: integer);
begin
  if Value>Length(fArray) then SetLength(fArray,Value)
  else SetLength(fArray,fCount);
end;

procedure TRecordList.SetCount(const Value: integer);
var
  i:integer;
begin
  if Value < 0 then Error(format('%s - При установке количества элементов передан неверный параметр - %d',[className,value]));
  if Value = 0 then Clear;
  if Value = fCount then exit;
  if Value < fCount then
    begin
      for i:=Value-1 to fCount-1 do Finalize(fArray[i]);
      fCount:=Value
    end
  else
    begin
      if Value > Length(fArray) then
        begin
          SetLength(fArray,Value);
          FillChar(fArray[fCount-1],SizeOf(TDATA_TYPE)*(Value-fCount),0);
        end;
    end;
end;

procedure TRecordList.SetItem(i: integer; const Value: pDATA_TYPE);
begin
  if (i<0) or (i>fCount) then Error(format('%s - индекс устанавливаемого элемента (%d) находиться вне необходимых границ (0 -:- %d)',[self.classname,i, fcount]));
  Finalize(fArray[i]);
  fArray[i]:=Value^;
end;

procedure TRecordList.MoveElementsDown(AIndex: integer);
begin
  Move(fArray[Aindex+1],fArray[Aindex],SizeOf(TDATA_TYPE)*(fCount - Aindex - 1));
  FillChar(fArray[fCount-1],SizeOf(TDATA_TYPE),0);
end;

procedure TRecordList.Sort;
procedure QuickSort(L, R: Integer);
var
  I, J: Integer;
  P: TDATA_TYPE;
  T: TDATA_TYPE;
begin
  repeat
    I := L;
    J := R;
    P := fArray[(L + R) shr 1];
    repeat
      while CompareRec(@fArray[I], @P) < 0 do Inc(I);
      while CompareRec(@fArray[J], @P) > 0 do Dec(J);
      if I <= J then
        begin
          T := fArray[I];
          fArray[I] := fArray[J];
          fArray[J] := T;
          Inc(I);
          Dec(J);
        end;
    until I > J;
    if L < J then QuickSort(L, J);
    L := I;
  until I >= R;
end;
begin
  if fCount > 0 then QuickSort(0,fCount-1);
end;

end.


Большое спасибо Антону и Александру!

А теперь третье письмо:


Для завершения (обновления) и т.п. наших программных продуктов ищем
сторонние организации (спонсоров, инвесторов, дилеров, разработчиков и т.п.
друзей). Помогите их найти!!! Информация о нас и нашей работе см. на
временном сайте... Мы медленно выходим из тени! -:)
С уважением,
Борис Суручану,
suruceab@n3-design.com,
www.n3.ournet.md


Зашел на этот сайт. Ничего там не увидел (у меня обычно отключена графика), кроме даты "начала вхождения в рынок" организации с загадочным названием "NTS - Grup" (наверно, Grup надо понимать как Group ?;)

Потом нащупал рисунки-ссылки...
Оказалась, что "научно-техническая, внедренческая, посредническая и консультативная фирма NTS-Grup" разработала компьютерные обучающие системы: для обучения специалистов артиллерии и для обучения специалистов ПВО. 8-|

По-моему работа на военных - не есть хорошее дело.
А фраза про "выход из тени" выглядит еще более...


Ведущий проекта - Алексей.

Есть что сказать? пишите сюда: blackbox@mailru.com
Все, что вы напишете, может быть использовано для вас в рассылке (в том числе ваша подпись под письмом).
Если вы против публикации своего письма, укажите тему письма "секретно" или "не публиковать".

По вопросам идеология проекта - смотри идеи Школы своего Дела (ШСД).
Рекомендую: лучшие рассылки по бизнесу и развитию личности .

Архив выпусков рассылки находится здесь http://blackbox.mailru.com



http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное