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

RFpro.ru: Программирование на Delphi и Lazarus

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 3.307 RSS
←   Февраль 2010   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28


За последние 60 дней ни разу не выходила


Сайт рассылки: http://rusfaq.ru/
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

3.307 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на Delphi и Lazarus


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed
Статус: Практикант
Рейтинг: 2096
∙ повысить рейтинг » 		Boriss
Статус: Академик
Рейтинг: 1742
∙ повысить рейтинг » 		Jimhucksly
Статус: 5-й класс
Рейтинг: 635
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И ПО / Программирование / Delphi и Lazarus

Номер выпуска:1490
Дата выхода:04.02.2010, 01:00
Администратор рассылки:Калашников О.А., Руководитель
Подписчиков / экспертов:551 / 226
Вопросов / ответов:1 / 1

Вопрос № 176384: Здравствуйте! Требуется сформировать экранную форму: «Ввод остатков по складу готовой продукции»

Вопрос № 176384:

Здравствуйте! Требуется сформировать экранную форму: «Ввод остатков по складу готовой продукции»

Таблица KACZCH.DBF
Из KACZCH.dbf:
«Черт N – Наименование» - NCHTO;
«Ед.изм.» - EI – писать «шт»;
«Цена» - OCN.
Поля «Кол-во» и «№ кладовщика» пустые, в них вводить информацию
«Дата остатков» - ввести с клавиатуры
«№ кладовщика» - значение от 1 до 3 (Работают 3 человека, и каждый ведёт свои позиции)
«Поиск по наименованию» - по введенному в поле поиска части NCHTO, найти строку на экранной форме, соответствующую введенным данным для поиска (например «Вал»)
По кнопке «Сохранить» формировать файл OSGP.dbf, где:
DOST - Дата остатков
CHTO - CHTO ( -//-)
NCHTO - NCHTO ( -//-)
OCN – OCN ( -//-)
VES – VES ( -//-)
EI – EI ( -//-)
NKL - № кладовщика (экранная форма)
NSK L – присвоить 72 (по всем записям)
OST – Кол-во (экранная форма)
CI – CI ( -//-)
KZK – KZK ( -//-)
Предусмотреть при сохранении возможность повторной записи данных в OSGP.
Структура остатков по складу готовой продукции

Заранее огромное спасибо!


Отправлен: 30.01.2010, 00:31
Вопрос задал: Судейкин Андрей Владимирович, Посетитель
Всего ответов: 1
Страница вопроса »

Отвечает Евгений/Genia007/, Бакалавр :
Здравствуйте, Судейкин Андрей Владимирович.
Получилось вполне неплохо. По договорённости на форме вместо полей ввода поставил сетку для отображения результатов поиска, поиск начинается после ввода искомого слова в поле поиска и нажатия клавиши enter.
Код:
unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Mask, Grids, DB, DBTables;

type
  TForm1 = class(TForm)
    Table1: TTable;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Button1: TButton;
    MaskEdit1: TMaskEdit;
    Query1: TQuery;
    Strin
 gGrid1: TStringGrid;
    ComboBox1: TComboBox;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure ComboBox1Exit(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);

   procedure Button2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
     function CreateTable(TabName, TabStruct, TabIDX: string): boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FileNames: String;

implementation

{$R *.dfm}

const
  CreateTab = 'CREATE TABLE ';
  IDXTab = 'PRIMARY KEY ';
  MyTabStruct =    'DOST DATE, ' +
    'CHTO CHARACTER(18), ' +
    'NCHTO CHARACTER(50), ' +
    'OCN DECIMAL(12,2), ' +
    'VES DECIMAL(10,3), ' +
    'NKL CHARACTER(1), ' +
    'NSKL CHARACTER(2), ' +
    'EI CHARACTER(2), ' +
    'CI CHARACTER(2), ' +
    'OST DECIMAL(5), ' +
    'KZK CHARACTER(6) ';

function TForm1.CreateTable(TabName, TabStruct, TabIDX: string): boolean;  //  Создаём новую
таблицу
begin
  result := true;
  with Query1 do  //  Для query делаем
  try
    try
      SQL.Clear;  //  Отчистили запрос
      SQL.Add(CreateTab + TabName + '(' + TabStruct + TabIDX + ')');  //  Добавили новый запрос
      Prepare;  //  Оптимизация выполнения запроса
      // ExecSQL, а не Open. Иначе ... облом
      ExecSQL;  //  Выполняем запрос
    except
      // Обработка ошибок открытия таблицы Возможности обрабо
 тчика можно расширить.
      Exception.Create('Ошибка открытия таблицы');  //  Генерация исключения
      result := false;
    end;
  finally
    Close;  //  Закрыть запрос
  end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  {Перебросим выбранное в значение из ComboBox в grid}
  StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row]:= ComboBox1.Items[ComboBox1.ItemIndex];
  ComboBox1.Visible:= False;  //  Спрятали комбобокс
  StringGrid1.SetFocus;
 //  Фокус на сетку
end;

procedure TForm1.ComboBox1Exit(Sender: TObject);
begin
  {Перебросим выбранное в значение из ComboBox в grid}
  StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row]:= ComboBox1.Items[ComboBox1.ItemIndex];
  ComboBox1.Visible:= False;  //  Спрятали комбобокс
  StringGrid1.SetFocus;  //  Фокус на сетку
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  row: integer;
begin
  MaskEdit1.Text:= (
 DateToStr(Now));  //  Присвоили полю ввода текущую дату
  ComboBox1.Visible:= False; //  Спрятать combobox
  {Высоту combobox'а 
не изменишь, так что вместо combobox'а
  будем изменять высоту строки grid'а !}
  StringGrid1.DefaultRowHeight:= ComboBox1.Height;

  {Table1.TableName:= ExtractFilePath(ParamStr(0))+'1413.DBF';  }//  Добавление имя базы
  FileNames:= #39 + ExtractFilePath(ParamStr(0)) + '1413.DBF' + #39;  //  Получили строку с именем файла исходной таблицы
  Query1.Close;  //  Закрыли запрос
  Query1.SQL.Clear;  //  Отчистили запрос
  Query1.SQL.Add('Select * from ' +
FileNames);  //  Добавили новый запрос
  Query1.Open;  //  Открыли запрос
  Query1.first;  //  Перешли на первую строку запроса
  //  Выставляем нужную ширину колонок сетки
  StringGrid1.colWidths[0]:= StringGrid1.Width - 335;
  StringGrid1.colWidths[1]:= 60;
  StringGrid1.colWidths[2]:= 64;
  StringGrid1.colWidths[3]:= 64;
  StringGrid1.colWidths[4]:= 119;
  //
  row:= 0;
  StringGrid1.rowcount:= Query1.recordCount;  //  Уравняли количеств
 о строк в сетке с количеством записей в запросе
  while not Query1.eof do  //  Пока не достигнут конец запроса делаем
  begin
    StringGrid1.cells[0,row]:= Query1.FieldValues['NCHTO'];  //  Добавляем данные в сетку
    StringGrid1.cells[1,row]:= 'шт';
    StringGrid1.cells[2,row]:= Query1.FieldValues['OCN'];
    inc(row);  //  Увеличили на 1
    Query1.next;  //  Переход на следующую запись
  end;
end;

procedure TForm1.Edit2KeyPress(Sender: TObject;
var Key: Char);
var
  row: integer;
begin
  if key = #13 then  //  Делаем поиск по нажатию enter
    begin
      // выполнить поиск
      Query1.Close;  //  Закрыли запрос                               // |
      Query1.SQL.Clear;        //  ' LIKE "%'+Edit2.Text+'%"' - ищет фрагмент текста
      Query1.SQL.Add('Select * from ' + FileNames + ' where NCHTO LIKE "%'+Edit2.Text+'%"');
 
      Query1.Open;  //  Окрыли запрос
      if Query1.RecordCount <> 0 then  //  Если количество записей не равно 0 вставляем данные в сетку
        begin
          row:= 0;
          StringGrid1.rowcount:= Query1.recordCount;
          while not Query1.eof do
            begin
              StringGrid1.cells[0,row]:= Query1.FieldValues['NCHTO'];
              StringGrid1.cells[1,row]:= 'шт';
              StringGrid1.cells[2,row]:= Query1.FieldValues['OCN'];

             StringGrid1.cells[3,row]:= '';
              StringGrid1.cells[4,row]:= '';
              inc(row);
              Query1.next;
            end;
        end
      else  //  Иначе делаем запрос с текстом из заглавных букв
        begin
          Query1.Close;                              // |
          Query1.SQL.Clear;        //  ' LIKE "%'+Edit2.Text+'%"' - ищет фрагмент текста
          Query1.SQL.Add('Select * from ' + FileNames + ' where NCHTO LIKE "%'+AnsiUpperCase(Edit2.Text)+'%"');
          Query1.Open;
          if Query1.RecordCount <> 0 then  //  Если количество записей не равно 0 вставляем данные в сетку
            begin
              row:= 0;
              StringGrid1.rowcount:= Query1.recordCount;
              while not Query1.eof do
                begin
                  StringGrid1.cells[0,row]:= Query1.FieldValues['NCHTO'];

                 StringGrid1.cells[1,row]:= 'шт';
                  StringGrid1.cells[2,row]:= Query1.FieldValues['OCN'];
                  StringGrid1.cells[3,row]:= '';
                  StringGrid1.cells[4,row]:= '';
                  inc(row);
                  Query1.next;
                end;
            end
        end;
    end;
end;

procedure TForm1.Button1Cl
 ick(Sender: TObject);
var
  i: integer;
  s: string;
begin
  if not FileExists(ExtractFilePath(ParamStr(0))+'OSGP.DBF&#
39;) then  //  Если таблицы не существует
    CreateTable('"OSGP.DBF"', MyTabStruct, '');  //  Создаём её
  Table1.TableName:= ExtractFilePath(ParamStr(0))+'OSGP.DBF';  //  Добавление имя базы
  Table1.Active:= true;  //  Открыли таблицу

  for i:= 0 to StringGrid1.RowCount - 1 do  //  Проходим все строки сетки
    if (StringGrid1.Cells[3, i] <> '') or (StringGrid1.Cells[4, i] <> '') then  //  Если ввели число в ячейку
      begin

       s:= #39 + StringGrid1.Cells[0, i] + #39;  //  Получаем строку для запроса обрамлённую апострофами
        Query1.Close;  //  Закрыли запрос
        Query1.SQL.Clear;  //  Отчистили запрос
        Query1.SQL.Add('Select * from ' + FileNames + ' where NCHTO = '+s+'');  //  Добавили запрос
        Query1.Open;  //  Открыли запрос
        if Table1.Locate('NCHTO', StringGrid1.Cells[0, i], [loPartialKey]) then  //  
 Нашли в таблице нужную запись
          begin  //  Такие данные уже есть
            if ((Table1.FieldValues['DOST'] = MaskEdit1.Text) and (Table1.FieldValues['NKL'] = StringGrid1.Cells[4, i]) and (Table1.FieldValues['OST'] = StringGrid1.Cells[3, i])) then
              ShowMessage('Введенные данные для записи ' + StringGrid1.Cells[0, i] + ' имеются в базе ISGP.dbf')
            else
              begin  //  Меняем данные в записи
                Table1.Edit;
 //  Ставим запись на редлактирование
                Table1.FieldValues['DOST']:= MaskEdit1.Text;  //  Записываем новые данные
                Table1.FieldValues['CHTO']:= Query1.FieldValues['CHTO'];
                Table1.FieldValues['NCHTO']:= Query1.FieldValues['NCHTO'];
                Table1.FieldValues['OCN']:= Query1.FieldValues['OCN'];
                Table1.FieldValues['VES']
 := Query1.FieldValues['VES'];
                Table1.FieldValues['EI']:= Query1.FieldValues['EI'];
                Table1.FieldValues['NKL']:= StringGrid1.Cells[4, i];
                Table1.FieldValues['NSKL']:= '72';
                Table1.FieldValues['OST']:= StringGrid1.Cells[3, i];
                Table1.FieldValues['CI']:= Query1.FieldValues['CI'];
                Table1.FieldValues['KZK']:= Query1.FieldValues['KZK'];

               Table1.Post;  //  Сохранили изменения
              end;
          end
        else  //  Нужную запись не нашли
          begin
            Table1.Insert;  //  Вставили новую запись в таблицу
            Table1.FieldValues['DOST']:= MaskEdit1.Text;  //  Записываем новые данные
            Table1.FieldValues['CHTO']:= Query1.FieldValues['CHTO'];
            Table1.FieldValues['NCHTO
 ']:= Query1.FieldValues['NCHTO'];
            Table1.FieldValues['OCN']:= Query1.FieldValues['OCN'];
            Table1.FieldValues['VES']:= Query1.FieldValues['VES'];
            Table1.FieldValues['EI']:= Query1.FieldValues['EI'];
            Table1.FieldValues['NKL']:= StringGrid1.Cells[4, i];
            Table1.FieldValues['NSKL']:= '72';
            Table1.FieldValues['OST']:= StringGrid1.Cells[3,
i];
            Table1.FieldValues['CI']:= Query1.FieldValues['CI'];
            Table1.FieldValues['KZK']:= Query1.FieldValues['KZK'];
            Table1.Post;  //  Сохранили таблицу
          end;
      //
      end;
  Table1.Active:= false;  //  Закрыли таблицу
end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
  R: TRect;
begin
  if (ACol = 3) or (ACol = 4) then  //  Редактируем только 3 и 4 ячейки
    StringGrid1.Options := StringGrid1.Options + [goEditing]  
//  Разрешаем редактировать таблицу
  else
    StringGrid1.Options := StringGrid1.Options - [goEditing];  //  Запрещаем редактировать таблицу
  if ACol = 4 then
  begin
    {Ширина и положение ComboBox должно соответствовать ячейке StringGrid}
    R:= StringGrid1.CellRect(ACol, ARow);
    R.Left:= R.Left + StringGrid1.Left;
    R.Right:= R.Right + StringGrid1.Left;
    R.Top:= R.Top + StringGrid1.Top;
    R.Bottom:= R.Bottom + StringGrid1.Top;
    ComboBox1.Left:= R.Left + 1;

   ComboBox1.Top:= R.Top + 1;
    ComboBox1.Width:= (R.Right + 1) - R.Left;
    ComboBox1.Height:= (R.Bottom + 1) - R.Top; {Покажем combobox}
    ComboBox1.Text:= '';
    ComboBox1.Visible:= True;
    ComboBox1.SetFocus;
  end;
  CanSelect:= True;
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  case key of  //  Разрешаем вводить только цифры
   '0'..'9' : ;
   #8 : ;<
 br>   #13: ;
  else
    key:= chr(0);  //  Другие символы не отображать
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  row: integer;
begin
  Query1.Close;  //  Закрыли запрос
  Query1.SQL.Clear;  //  Отчистили запрос
  Query1.SQL.Add('Select * from ' + FileNames);  //  Добавили новый запрос
  Query1.Open;  //  Открыли запрос
  Query1.first;  //  Перешли на первую запись
  row:= 0;
  StringGrid1.rowcount:= Query1.recordCount;  //  Выставили
количество строк в сетке сколько записей в запросе
  while not Query1.eof do  //  Пока не бедет конец запроса делаем
  begin
    StringGrid1.cells[0,row]:= Query1.FieldValues['NCHTO'];  //  Заносим данные в сетку
    StringGrid1.cells[1,row]:= 'шт';
    StringGrid1.cells[2,row]:= Query1.FieldValues['OCN'];
    StringGrid1.cells[3,row]:= '';
    StringGrid1.cells[4,row]:= '';
    inc(row);  //  Увеличил
 и на 1
    Query1.next;  //  Перешли на новую запись запроса
  end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  StringGrid1.colWidths[0]:= StringGrid1.Width - 335;
end;

end.
Весь проект можно скачать здесь.
-----
Помогли тебе, помоги и ты.

Ответ отправил: Евгений/Genia007/, Бакалавр
Ответ отправлен: 31.01.2010, 21:29
Номер ответа: 259103

Оценка ответа: 5
Комментарий к оценке:
Великолепно!

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это!
Как сказать этому эксперту "спасибо"?
  • Отправить SMS #thank 259103 на номер 1151 (Россия) | Еще номера »
  • Отправить WebMoney:

    • Оценить выпуск »
    Нам очень важно Ваше мнение об этом выпуске рассылки!

    Задать вопрос экспертам этой рассылки »

    Скажите "спасибо" эксперту, который помог Вам!

    Отправьте СМС-сообщение с тестом #thank НОМЕР_ОТВЕТА
    на короткий номер 1151 (Россия)
    Номер ответа и конкретный текст СМС указан внизу каждого ответа.

    Полный список номеров »

    * Стоимость одного СМС-сообщения от 7.15 руб. и зависит от оператора сотовой связи. (полный список тарифов)
    ** При ошибочном вводе номера ответа или текста #thank услуга считается оказанной, денежные средства не возвращаются.
    *** Сумма выплаты эксперту-автору ответа расчитывается из суммы перечислений на портал от биллинговой компании.

    © 2001-2010, Портал RFpro.ru, Россия
    Авторское право: ООО "Мастер-Эксперт Про"
    Автор: Калашников О.А. | Программирование: Гладенюк А.Г.
    Хостинг: Компания "Московский хостер"
    Версия системы: 2010.6.14 от 03.02.2010
    В избранное