Уроки 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;

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

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

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

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;

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

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

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

О нас

Помощь

Способы оплаты

Проекты Interface Ltd.