(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Уроки Delphi. Обобщающий графический отчет.

Источник: pro-delphi
Александр Веселов

Пройдет время. Скажем, год. База данных наполнится цифрами...
И Вам обязательно захочется взглянуть на некую общую картину. А мне, как и прежде, уже сейчас хочется рассказать о практическом применении тех компонентов, о которых мы пока не говорили.

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

Добавьте в проект новую форму

 

назвав ее AnalizTrendsForm, а модуль формы соответственно AnalizTendenc.

Большинство компонентов (кнопки, панели, TPageControl и TDBGridEh) нам знакомы, вряд ли стоит подробно останавливаться на них. К тому же, если компонент не обрабатывается в коде, то я даже не имею привычки его переименовывать.

К таким же привычным компонентам можно отнести TADOQuery, которому советую не забыть назначить свойство Connection. Любознательно-наблюдательные читатели спросят, а, может быть, даже упрекнут меня в том, что вместо этого компонента можно использовать имеющийся на главной форме TempQuery. Да, можно. Внесите изменения (оптимизируйте) самостоятельно :-)

 

аким же привычным компонентом уже стал, наверное, компонент TChart.

 

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

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

 

По сути этого компонента можно сказать, что это невизуальный компонент, аналогичный обычному массиву. Все, что в него попадает, остается в ОЗУ, поэтому работает он очень быстро. Но, есть одна особенность. Являясь стандартным компонентом, устанавливаемым совместно со средой обработки, этот компонент не будет работать без наличия в системе специальной библиотеки midas.dll, что удивительно. Этот файл необходимо расположить в каталоге C:\Windows\System32, а затем зарегистрировать его с помощью "Выполнить: regsvr32 c:\windows\system32\midas.dll". Если Вы не знаете, как это сделать, скачайте исполняемый файл, разместите его в том же каталоге, куда скачали Dll, и дважды щелкните по этому файлу. Все произойдет само собой :-) 

Не убирайте далеко в корзину и навсегда файл библиотеки. Ближе к финалу данной темы я планирую рассказать о создании (мы же с Вами - взрослые люди) настоящего инсталлятора для  программы "Расходы", так что файл библиотеки нам еще пригодится.

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

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

Чтобы данные, размещенные в CDS были видны в таблице, расположенной на одноименной вкладке на форме, необходимо оформить связь:

 

В качестве вступительного слова при переходе к коду программы, приведу почти знакомый фрагмент, включающий традиционные процедуры создания формы, закрытия ее и некоторые другие:

 private
    { Private declarations }
    procedure MyClose();
    procedure Prepare();
  public
    { Public declarations }
  end;

var
  AnalizTrendsForm: TAnalizTrendsForm;
  MyColor: array[1..16] of TColor = (
                                    clMaroon
                                    ,clGreen
                                    ,clYellow
                                    ,clOlive
                                    ,clNavy
                                    ,clPurple
                                    ,clTeal
                                    ,clLime
                                    ,ClGray
                                    ,clRed
                                    ,clSilver
                                    ,clBlue
                                    ,ClFuchsia
                                    ,clAqua
                                    ,clMoneyGreen
                                    ,clSkyBlue
                                    );

implementation

{$R *.dfm}

Uses Main;

// Традиционный набор процедур
procedure TAnalizTrendsForm.FormCreate(Sender: TObject);
begin
  StringGrid1.ColWidths[0]:=50;
  StringGrid1.ColWidths[1]:=150;
  PageControl1.ActivePage:=TabSheet1;
  Prepare();
end;

procedure TAnalizTrendsForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:= caFree;
end;

procedure TAnalizTrendsForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of            // Start Case

    VK_ESCAPE:
      begin
        MyClose;
      end;

    else

  End;                   // End case

end;

procedure TAnalizTrendsForm.MyClose();
begin
  close;
end;

procedure TAnalizTrendsForm.PrDOkButton1Click(Sender: TObject);
begin

  if (ModalResult=1) OR (ModalResult=2)
  then
  Begin
    MyClose;
  end;

end;

А ниже - то, ради чего все это затевалось:

Процедура очистки графика:

procedure TAnalizTrendsForm.BitBtn1Click(Sender: TObject);
begin

  // Очистка графика
  With  Chart1 do
  While SeriesCount>0 do
  begin
    Series[0].Free;
  end;
end;


Здесь я должен пояснить основную идею, которую должна реализовать данная форма:
в список слева (StringGrid) нужно вывести все счета, по которым были обороты в текущем году. При щелчке по строке этого списка программа должна добавлять в график новую серию, раскрасив ее в один из 16 оговоренных в массиве MyColor цветов и изменив масштаб отображения.

Использованная в процедуре создания формы подпрограмма Prepare() по сути - наполняет список счетов в StringGrid (обратите внимание, что здесь, как и в следующей процедуре прописан механизм обработки ошибок):

procedure TAnalizTrendsForm.Prepare();
Var
  MyStr: String;
  j,i: Integer;
  ErrKod: Integer;                              // Код ошибки
  ErrMes: String;                               // Описание ошибки

Label
  ErrorsLab;                                      // Метка, после которой начинается текст обработчика ошибок
begin

  // Стартовые значения
  ErrKod:=0;
  ErrMes:='Операция завершена успешно';

  // Определить количество задействованных счетов в течение года
  ADOQuery1.Active:=False;
  ADOQuery1.SQL.Clear;
  MyStr:='SELECT Accounts.ID, Accounts.Name ';
  MyStr:=MyStr + 'FROM Accounts INNER JOIN Main ON Accounts.ID = Main.D ';
  MyStr:=MyStr + 'WHERE (((Accounts.Analiz)=True) AND ((Year([Main]![MyDate]))='+FormatDateTime('yyyy',(now()))+')) ';
  MyStr:=MyStr + 'GROUP BY Accounts.ID, Accounts.Name';
  ADOQuery1.SQL.Add(MyStr);
  ADOQuery1.Active:=True;

  // Есть ли данные за текущий год?
  If Not (ADOQuery1.RecordCount>0)
  then
  begin
    ErrKod:=1;
    ErrMes:='Список пуст:'+CR+'Нет счетов, задействованных в текущем году';
    GoTo ErrorsLab;
  end;

  // Создать CDS
  CDS.Active:=False;
  CDS.FieldDefs.Clear;
  CDS.FieldDefs.add('Месяц',ftInteger,0,False);    // Будут вписаны номера месяцев от 1 до 12

    // В цикле по созданному массиву создаем поля - коды счетов в заголовках
    // а также - наполняем сетку, отображающую набор счетов
    j:=0;
    while (Not ADOQuery1.Eof) do
    Begin
      CDS.FieldDefs.add(ADOQuery1.FieldByName('ID').AsString,ftInteger,0,False);
      StringGrid1.Cells[0,j]:=ADOQuery1.FieldByName('ID').AsString;
      StringGrid1.Cells[1,j]:=ADOQuery1.FieldByName('Name').AsString;
      StringGrid1.RowCount:=StringGrid1.RowCount+1;
      inc(j);
      ADOQuery1.Next;
    end;
    StringGrid1.RowCount:=StringGrid1.RowCount-1;                   // Одна строка лишняя

  CDS.CreateDataSet;                                                // Создание датасета
  CDS.IndexFieldNames:='Месяц';

  // Наполнение CDS
    // Номера месяцев
    For j:=1 to 12 do
    begin
      CDS.Insert;

      // Обнуление CDS
      for i := 0 to CDS.FieldCount - 1 do
        CDS.Fields[i].Value:=0;
      CDS.FieldByName('Месяц').Value:=j;
      CDS.Post;
    end;

    // Данные
    CDS.First;
    While Not CDS.Eof do
    begin
      ADOQuery1.Active:=False;
      ADOQuery1.SQL.Clear;
      MyStr:='SELECT Month([MyDate]) AS Mes, Sum(Main.Summa) AS [MySum], Accounts.Name, Accounts.ID ';
      MyStr:=MyStr + 'FROM Accounts INNER JOIN Main ON Accounts.ID = Main.D ';
      MyStr:=MyStr + 'WHERE (((Accounts.Analiz)=True) AND ((Year([Main]![MyDate]))='+FormatDateTime('yyyy',(now()))+')) ';
      MyStr:=MyStr + 'GROUP BY Month([MyDate]), Accounts.Name, Accounts.ID, Year([Main]![MyDate]) ';
      MyStr:=MyStr + 'HAVING (((Month([MyDate]))='+CDS.FieldByName('Месяц').AsString+'))';
      ADOQuery1.SQL.Add(MyStr);
      ADOQuery1.Active:=True;

      While Not ADOQuery1.Eof do
      begin
        CDS.Edit;
        CDS.FieldByName(ADOQuery1.FieldByName('ID').AsString).Value:=ADOQuery1.FieldByName('MySum').Value;
        CDS.Post;
        ADOQuery1.Next;
      end;

      CDS.Next;
    end;


  // Настройка сетки
  DBGridEh1.Columns.AddAllColumns(True);

  exit;                           // Нужен, если нет необходимости выводить сообщение об успешном завершении операции

ErrorsLab:

  case ErrKod of            // Start Case

    0:
      begin

        // Сообщение об успешном завершении
        MainFrm.MyMessenger.TitleString:='...';
        MainFrm.MyMessenger.MessageType:=mtInformation;

      end;
    else
      begin

        // Сообщения об ошибках
        MainFrm.MyMessenger.TitleString:='Ошибка ('+IntToStr(ErrKod)+')';
        MainFrm.MyMessenger.MessageType:=mtError;
      end;
  End;                   // End case

  MainFrm.MyMessenger.MessageString:=ErrMes;
  MainFrm.MyMessenger.Buttons:=[mbOk];
  MainFrm.MyMessenger.ShowMessage;

end;

А теперь - обработчик клика по сетке (списку счетов):

procedure TAnalizTrendsForm.StringGrid1Click(Sender: TObject);
Var
  i: Integer;
  ErrKod: Integer;                              // Код ошибки
  ErrMes: String;                               // Описание ошибки

Label
  ErrorsLab;                                      // Метка, после которой начинается текст обработчика ошибок
begin

  // Стартовые значения для
  ErrKod:=0;
  ErrMes:='Операция завершена успешно';

  // Если в сетке ничего нет, то - выход
  If StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row]=''
  then
    exit;

  // Первая из возможных проверок (количество графиков не может быть более 16)
  If Chart1.SeriesCount=15
  then
  begin
    ErrKod:=1;
    ErrMes:='Возможно создать только 16 графиков';
    GoTo ErrorsLab;
  end;

  // Добавление новой серии
  With Chart1 do
  begin

    i:=SeriesCount;

    AddSeries(TLineSeries.Create(Self));
    Series[i].Name := 'Serija_'+IntToStr(i);

  end;

  With Chart1.Series[i] do
  begin
    CDS.First;
    While not CDS.Eof do
    begin
      Add(CDS.FieldByName(StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row]).Value, CDS.FieldByName('Месяц').Value, MyColor[i+1]);
      CDS.Next;
    end;
  end;

  exit;                           // Нужен, если нет необходимости выводить сообщение об успешном завершении операции

ErrorsLab:

  case ErrKod of            // Start Case

    0:
      begin

        // Сообщение об успешном завершении
        MainFrm.MyMessenger.TitleString:='...';
        MainFrm.MyMessenger.MessageType:=mtInformation;

      end;
    else
      begin

        // Сообщения об ошибках
        MainFrm.MyMessenger.TitleString:='Ошибка ('+IntToStr(ErrKod)+')';
        MainFrm.MyMessenger.MessageType:=mtError;
      end;
  End;                   // End case

  MainFrm.MyMessenger.MessageString:=ErrMes;
  MainFrm.MyMessenger.Buttons:=[mbOk];
  MainFrm.MyMessenger.ShowMessage;

end;


В результате Вы получите вот такие графики, если станете щелчком выбирать строки в списке (в моей БД сохранилась информация только за первые два месяца :-) ):

Ссылки по теме


 Распечатать »
 Правила публикации »
  Написать редактору 
 Рекомендовать » Дата публикации: 01.06.2012 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Enterprise Connectors (1 Year term)
Delphi Professional Named User
Купить, скачать Dr.Web Security Space, 1 год, 1 ПК
Купить WinRAR : 5 : Академическая лицензия 1 лицензия
Microsoft Office 365 Профессиональный Плюс. Подписка на 1 рабочее место на 1 год
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Новости ITShop.ru - ПО, книги, документация, курсы обучения
СУБД Oracle "с нуля"
OS Linux для начинающих. Новости + статьи + обзоры + ссылки
Новые материалы
Программирование на Visual Basic/Visual Studio и ASP/ASP.NET
Новые программы для Windows
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
 



    
rambler's top100 Rambler's Top100