Social Icons

среда, 25 сентября 2013 г.

Что бы сделали мы с Delphi XE5/XE6... - подводим итоги

С некоторым запозданием подводим обещанные итоги летнего опроса.

Вот, пятерка пожеланий-победителей:
  1. Исправить баги и "тормоза" в QC, в т.ч. переходящие от версии к версии (13).
  2. Выпустить Delphi-Express, литературу по новым возможностям и современному состоянию языка/среды, в т.ч. на глубоком уровне; оптимизировать и повысить скорость исполняемых файлов; сделать компилятор под Linux (6).
  3. Улучшить справочную систему (быстродействие, содержание) (5).
  4. Снизить цены на Delphi/RAD Studio; усовершенствовать IDE (4).
  5. Значительно расширить компонентную базу, добавить полноценные компоненты, а не урезанные версии, исправить существующие (например, TBalloonHint или Ribbon); провести качественный рефакторинг и нативные компоненты в FM; улучшить стабильность и скорость среды (3).
В скобках указано количество голосов, полученное путем группировки мнений авторов. В случае, если одно и тоже количество голосов набирало несколько позиций - им присваивалось одно и тоже место, а сами позиции разделялись точкой с запятой.

В пятерке явно выделяется желание увидеть пофикшеные баги, остальные пункты обладают примерно одинаковой степенью влияния. Наиболее неожиданным для меня является появление в топе наличия компилятора под Linux.

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

воскресенье, 4 августа 2013 г.

Numerics для Delphi & FPC (работа с большими числами)

Сергей Касандров выпустил довольно интересный модуль для работы с большими числами в Delphi и FreePascal (сделано на чистом Паскале, без оптимизаций) - новость и архив. В архиве содержится исходный код модуля, а также тестовый проект и скомпилированные dll (32- и 64-битные).

вторник, 23 июля 2013 г.

CnPack IDE-Мастер: подсветка операторов управления потоком выполнения

В меню CnPack -> Настройки IDE-расширений -> Подсветка синтаксиса появилась новая опция - "Выделять операторы упр. потоком выполнения":
При включенной опции такие конструкции как Exit/Abort/Break/Continue/Raise будут выделены:

четверг, 18 июля 2013 г.

Что бы сделали мы с Delphi XE5/XE6/...

Уважаемые читатели блога и ленты Delphifeeds.ru!

Приглашаю всех неравнодушных к Delphi поучаствовать в следующем опросе. Задача такая - укажите в комментариях от 1 до 3 желаемых или просто необходимых фич в будущих версиях Delphi, которые с Вашей точки зрения способствовали бы развитию всестороннему продукта. Комментарии также могут относится к продукту не напрямую (например, рекомендация "проводить больше вебинаров"). Свои соображения я оставляю первым комментарием.

Старайтесь выражать мысли кратко и лаконично. В начале осени мы подведем итоги и составим "график желаний".

пятница, 5 июля 2013 г.

Как программно завершить работу, сделать перезагрузку, перевести компьютер в ждущий режим или выйти из системы в OS X?

Одним из простых путей является использование объекта Cocoa NSAppleScript для запуска следующего скрипта:
tell application "Finder" to shut down
И, конечно, ‘to shut down’ может быть заменено на ‘to restart’, ‘to sleep’ или ‘to log out’.

В последних версиях Delphi NSAppleScript (или если быть более точным - его интерфейс) объявлен в модуле Macapi.Foundation. Увы, объявлен он не совсем точно (см. здесь), поэтому его необходимо немного подправить следующим образом:
uses
  Macapi.ObjectiveC, Macapi.CocoaTypes, Macapi.Foundation;
 
type
  NSAppleScript = interface(NSObject)
    ['{0AB1D902-25CE-4F0B-A3BE-C4ABEDEB88BC}']
    function compileAndReturnError(errorInfo: Pointer): Boolean; cdecl;
    function executeAndReturnError(errorInfo: Pointer): Pointer; cdecl;
    function executeAppleEvent(event: NSAppleEventDescriptor; error: Pointer): Pointer; cdecl;
    function initWithContentsOfURL(url: NSURL; error: Pointer): Pointer; cdecl;
    function initWithSource(source: NSString): Pointer; cdecl;
    function isCompiled: Boolean; cdecl;
    function source: NSString; cdecl;
  end;

  TNSAppleScript = class(TOCGenericImport<NSAppleScriptClass, NSAppleScript>)  

end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Script: NSAppleScript;
  Error: Pointer;
begin
  Error := nil;
  Script := TNSAppleScript.Wrap(TNSAppleScript.Alloc.initWithSource(
    NSSTR('tell application "Finder" to shut down')));
  try
    if Script.executeAndReturnError(Error) = nil then
      raise EOSError.Create('AppleScript macro failed');
  finally
    Script.release;
  end;
end;
И все работает прекрасно.

Источник: http://delphihaven.wordpress.com/2013/07/04/programmatically-shutting-down-restarting-sleeping-or-logging-off-on-os-x/

четверг, 4 июля 2013 г.

Получение информации о системе в OSX и iOS с помощью Delphi (XE2, XE3, XE4) - Часть 2

Данная статья является продолжением статьи Получение информации о системе в OSX и iOS с помощью Delphi (XE2, XE3, XE4) - Часть 1.

Внутри модуля Posix.SysSysctl (являющимся, как уже было сказано, трансляцией файла sysctl.h) можно обнаружить ряд массивов (CTL_NAMES, CTL_KERN_NAMES, CTL_HW_NAMES, CTL_USER_NAMES, CTL_VM_NAMES), которые содержат идентификаторы системной информации, рассмотренные нами в предыдущей статье. Используя их, можно построить идентификатор (параметр name) для передачи в функцию SysCtlByName.

В качестве примера, составить идентификатор для получения версии ядра можно следующим образом:
Name := PAnsiChar(CTL_NAMES[CTL_KERN].ctl_name + '.' + CTL_KERN_NAMES[KERN_VERSION].ctl_name); // Версия ядра
а затем вызвать SysCtlByName:
function KernelVersion: AnsiString;
var
  res: Integer;
  len: size_t;
  p, Name: PAnsiChar;
begin
  len := SizeOf(Result);
  Name := PAnsiChar(CTL_NAMES[CTL_KERN].ctl_name + '.' + CTL_KERN_NAMES[KERN_VERSION].ctl_name);
  res := SysCtlByName(Name, nil, @len, nil, 0);
    if (len > 0) and (res = 0)  then
    begin
      GetMem(p, len);
      try
        res := SysCtlByName(Name, p, @len, nil, 0);
        if res = 0 then
          Result := p;
      finally
        FreeMem(p);
      end;
    end;
end;
Используя эти массивы, можно получить много полезной, предусмотренной в них информации, попробуйте воспроизвести следующий проект:
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
  System.Classes,
  System.Types,
  Posix.Errno,
  Posix.SysTypes,
  Posix.SysSysctl,
  System.SysUtils;
 
function GetsysctlIntValue(mib: TIntegerDynArray) : integer;
var
  len : size_t;
  res : integer;
begin
   len := sizeof(Result);
   res:=sysctl(@mib[0], 2, @Result, @len, nil, 0);
   if res<>0 then
    Result:=-1; // RaiseLastOSError;
end;
 
function GetsysctlInt64Value(mib: TIntegerDynArray) : Int64;
var
  len : size_t;
  res : integer;
begin
   len := sizeof(Result);
   res:=sysctl(@mib[0], 2, @Result, @len, nil, 0);
   if res<>0 then
     Result:=-1; //RaiseLastOSError;
end;
 
function GetsysctlStrValue(mib: TIntegerDynArray) : AnsiString;
var
  len : size_t;
  p   : PAnsiChar;
  res : integer;
begin
   Result:='';
   res:=sysctl(@mib[0], 2, nil, @len, nil, 0);
   if (len>0) and (res=0)  then
   begin
     GetMem(p, len);
     try
       res:=sysctl(@mib[0], 2, p, @len, nil, 0);
       if res=0 then
        Result:=p;
     finally
       FreeMem(p);
     end;
   end;
end;
 
procedure  ListKernelValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('High kernel limits');
 Writeln('------------------');
 for i:=0 to KERN_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_KERN, i);
    case CTL_KERN_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_KERN].ctl_name, CTL_KERN_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;
 
procedure  ListGenericCPU_IO_Values;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('Generic CPU, I/O');
 Writeln('-----------------');
 for i:=0 to HW_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_HW, i);
    case CTL_HW_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_HW].ctl_name, CTL_HW_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;
 
procedure  ListUserLevelValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 mib:=TIntegerDynArray.Create(CTL_USER, 0);
 Writeln('User-level');
 Writeln('----------');
 for i:=0 to USER_MAXID-1 do
 begin
    mib[1]:=i;
    case CTL_USER_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_USER].ctl_name, CTL_USER_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;
 
procedure  ListVMValues;
var
  mib : TIntegerDynArray;
  i   : Integer;
begin
 Writeln('Virtual memory');
 Writeln('-------------');
 for i:=0 to VM_MAXID-1 do
 begin
    mib:=TIntegerDynArray.Create(CTL_VM, i);
    case CTL_VM_NAMES[i].ctl_type of
     CTLTYPE_NODE  :  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, '[node]']));
     CTLTYPE_OPAQUE:  Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, '[structure]']));
     CTLTYPE_INT   :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlIntValue(mib)]));
     CTLTYPE_QUAD  :  Writeln(Format('%s.%-18s %d',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlInt64Value(mib)]));
     CTLTYPE_STRING : Writeln(Format('%s.%-18s %s',[CTL_NAMES[CTL_VM].ctl_name, CTL_VM_NAMES[i].ctl_name, GetsysctlStrValue(mib)]));
    end;
 end;
 Writeln;
end;
 
begin
  try
    ListKernelValues;
    ListGenericCPU_IO_Values;
    ListUserLevelValues;
    ListVMValues;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Источник: http://theroadtodelphi.wordpress.com/2013/06/29/getting-system-information-in-osx-and-ios-using-delphi-xe2-xe3-xe4-part-2/

среда, 3 июля 2013 г.

Получение информации о системе в OSX и iOS с помощью Delphi (XE2, XE3, XE4) - Часть 1

В статье будут рассмотрены вопросы использования функций модулей sysctl, sysctlbyname и sysctlnametomib для получения информации о системе (параметры ядра, железа, сети, файловой системы, информации о компьютере и пользователе) в OSX и iOS.

вторник, 16 апреля 2013 г.

Delphi XE4 уже рядом

Открыта регистрация на презентацию продукта: http://forms.embarcadero.com/forms/AMUSCA1304RADStudioLaunchWeb4-24

Интересно, с чем связано ускорение цикла выхода новых версий?

воскресенье, 3 марта 2013 г.

Qt QPropertyAnimation & FireMonkey Float Animation

На днях наткнулся на занимательное видео:


Данную штуку можно сделать уже в Qt 4.6 (это примерно 2009 г.). Аналогичные эффекты доступны в Firemonkey (c 2011 г.). Вопрос к знатокам: как соотносится первое со вторым и чем одно лучше/хуже другого?

понедельник, 18 февраля 2013 г.

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

В Delphi Вы можете произвести инициализацию динамического массива двумя способами: вручную или используя "магический" конструктор:
...
type
   TIntegerArray = array of Integer;

procedure Test;
var 
   a : TIntegerArray;
begin
   // "Магический" конструктор
   a := TIntegerArray.Create(1, 2);

   // Инициализация вручную
   SetLength(a, 2);
   a[0] := 1;
   a[1] := 2;
end;
На выходе получаем абсолютно идентичные массивы, но во всем ли эти способы одинаковы?

В чем же разница?
Первый способ более лаконичен, но при этом чуть менее эффективен; в этом можно убедиться, посмотрев в окно CPU:
...
// "Магический" конструктор
TestUnit.pas.32: a := TIntegerArray.Create(1, 2);
00511335 8D45F8           lea eax,[ebp-$08]
00511338 8B15F0125100     mov edx,[$005112f0]
0051133E E89576EFFF       call @DynArrayClear   // кто-нибудь знает, зачем?
00511343 6A02             push $02
00511345 8D45F8           lea eax,[ebp-$08]
00511348 B901000000       mov ecx,$00000001
0051134D 8B15F0125100     mov edx,[$005112f0]
00511353 E87476EFFF       call @DynArraySetLength
00511358 83C404           add esp,$04
0051135B 8B45F8           mov eax,[ebp-$08]
0051135E C70001000000     mov [eax],$00000001
00511364 8B45F8           mov eax,[ebp-$08]
00511367 C7400402000000   mov [eax+$04],$00000002
0051136E 8B55F8           mov edx,[ebp-$08]
00511371 8D45FC           lea eax,[ebp-$04]
00511374 8B0DF0125100     mov ecx,[$005112f0]
0051137A E89576EFFF       call @DynArrayAsg

// Инициализация вручную
TestUnit.pas.35: SetLength(a, 2);
0051137F 6A02             push $02
00511381 8D45FC           lea eax,[ebp-$04]
00511384 B901000000       mov ecx,$00000001
00511389 8B15F0125100     mov edx,[$005112f0]
0051138F E83876EFFF       call @DynArraySetLength
00511394 83C404           add esp,$04
TestUnit.pas.36: a[0] := 1;
00511397 8B45FC           mov eax,[ebp-$04]
0051139A C70001000000     mov [eax],$00000001
TestUnit.pas.37: a[1] := 2;
005113A0 8B45FC           mov eax,[ebp-$04]
005113A3 C7400402000000   mov [eax+$04],$00000002
Перед тем как обвинить во всем компилятор, Вам следует чуть глубже понять разницу в приведенных способах инициализации массивов:
  • в первом случае при создании массива все его элементы инициализируются единовременно, переводя его в определенное состояние;
  • в случае ручной инициализации, массив изменяется в несколько раз, и, соответственно, массив может быть определен не полностью.
Конечно, в нашем примере компилятор мог бы определить, что массив не виден извне процедуры, и сгенерировать меньший код, однако эта оптимизация смогла бы помочь только в случае локальной переменной.
В более общем случае, оптимизация могла бы заключаться в отказе компилятора от создания временных массивов, если инициализируемый массив не используется (таким образом неопределенность не имеет значения), это в свою очередь может стать предпосылкой зарождения идеи подсчета ссылок на массивы.

Больше деталей
Использование "магического" конструктора влечет за собой следующие издержки:
  • вызов DynArrayClear (не понимаю, зачем он здесь), освобождающий блок памяти, выделенный ранее для временного массива;
  • вызов DynArraySetLength, выделяющий новый блок памяти с последующим его обнулением;
  • вызов DynArrayAssign, приводящий к освобождению памяти, занимаемой текущим массивом (если он не пустой), а также локу счетчика ссылок и дополнительным инициализации и финализации временного массива.
В многопоточном приложении подобные дополнительные манипуляции с памятью и локи плачевно повлияют на производительность. Если Вы потестируете наш пример в многопоточной среде, то увидите, что при использовании "магического" конструктора выполнение кода сведется к однопоточному.
При ручной инициализации мы имеем только один вызов DynArraySetLength, и если массив не пустой, это может вообще не привести к выделению нового блока памяти (т.к. просто может быть уменьшен/увеличен существующий). Поэтому, если Вы инициализируете массив не один раз, ручная инициализация обойдется Вам дешевле.

Как сделать инициализатор лучше?
Мы увидели, что "магический" конструктор не является хорошим вариантом, но что если Вы хотите воспользоваться подобным удобным способом инициализации? На помощь приходят открытые массивы:
...
procedure InitializeArray(var a: TIntegerArray; const values: array of Integer);
begin
   SetLength(a, Length(values));
   if Length(values) > 0 then
      Move(values[0], a[0], Length(values)*SizeOf(Integer));
end;
...
InitializeArray(a, [1, 2]);
Указанная функция не будет эффективнее ручной инициализации: внутри будет происходить дополнительное копирование значений элементов. Однако, она убирает дополнительное выделение памяти и установку локов, поэтому больше подойдет для многопоточных приложений, будучи при этом компактной и лаконичной.
Обратите внимание, что для всех managed-типов (строк, интерфейсов и т.д.), которые System.Move не принимает в качестве аргумента, Вам понадобится использовать либо asm-хаки, либо инициализировать массив поэлементно (например, через цикл for-to-do), что во многих случаях сделает данный вариант неконкурентоспособным относительно ручного аналога.

Хотите еще лучше?
В общем случае, все приведенные выше подходы страдают от вызова довольно сложной процедуры SetLength (взгляньте на DynArraySetLength в System.pas и убедитесь), поэтому, если есть шанс, что динамический массив не изменится в размере, Вы можете выиграть сделав так:
...
if Length(a) <> Length(value) then
   SetLength(a, Length(Values));
Что может увеличить производительность до 10 раз.
Упс! А почему RTL этого не делает, спросите Вы?

Ответ прост - не может. Динамические массивы в Delphi - это не смесь простых типов и указателей, и SetLength - то место, где непосредственно проиходит определение, с чем мы имеем дело (для доп. изучения см. {1}, {2} и {3}).
В DWScript, например, динамические массивы - ссылочные типы, имеют больше возможностей, а их инициализация более компактна:
...
a := [1, 2];
А при использовании Smart Pascal в Chrome V8 или node.js Вам все-таки придется воспользоваться рассмотренными советами по оптимизации.

http://delphitools.info/2013/02/18/delphi-array-constructors-performance-or-lack-of/

четверг, 17 января 2013 г.

Штриховка в TChart

На днях коллега поинтересовался вопросом - а можно ли в стандартном TChart сделать что-то наподобии такого:

Гугл ответа не дал, поэтому пришлось думать над решением самому :). Нашлось оно довольно быстро следующим образом:
...
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VCLTee.TeEngine, VCLTee.Series,
  Vcl.ExtCtrls, VCLTee.TeeProcs, VCLTee.Chart, System.Generics.Collections;

type
  THatchDirection = (hdUp, hdDown);

  TForm1 = class(TForm)
    Chart1: TChart;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Chart1AfterDraw(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    var
      FHatchDirectionList: TList<THatchDirection>;
    procedure DrawHatch(Series: TChartSeries; HatchDirection: THatchDirection);
    procedure AddInEquation(XStart, XEnd, XStep: Double; YFunc: TFunc<Double,
        Double>; AHatchDirection: THatchDirection; AColor: TColor);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Содержит список направлений штриховок, индексация FHatchDirectionList[I} = Chart1.Series[I]
  FHatchDirectionList := TList<THatchDirection>.Create;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FHatchDirectionList.Clear;
  Chart1.ClearChart;
  Chart1.View3D := False;

  // Прямая
  AddInEquation(0, 50, 1,
                function(x: Double): Double
                begin
                  Result := x;
                end,
                THatchDirection.hdDown, clRed);

  // Еще одна
  AddInEquation(0, 50, 1,
                function(x: Double): Double
                begin
                  Result := 50 - x;
                end,
                THatchDirection.hdDown, clBlue);

  // Парабола
  AddInEquation(10, 40, 1,
                function(x: Double): Double
                begin
                  Result := 0.2 * sqr(x - 25) + 8;
                end,
                THatchDirection.hdUp, clGreen);
end;

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

procedure TForm1.DrawHatch(Series: TChartSeries; HatchDirection: THatchDirection);
const
  HATCH_SIZE = 10;
var
  i, k: Integer;
  XPos, YPos: Integer;
begin
  Chart1.Canvas.Pen.Color := Series.Color;
  Chart1.Canvas.Pen.Width := Series.Pen.Width - 1;
  case HatchDirection of
    hdUp:   k := -1;
    hdDown: k := 1;
  end;

  for i := 0 to Series.XValues.Count - 1 do
  begin
    XPos := Series.CalcXPosValue(Series.XValue[i]);
    YPos := Series.CalcYPosValue(Series.YValue[i]);
    Chart1.Canvas.Line(XPos, YPos, XPos, YPos + k*HATCH_SIZE);
  end;
end;

procedure TForm1.Chart1AfterDraw(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to FHatchDirectionList.Count - 1 do
    DrawHatch(Chart1.Series[i], FHatchDirectionList[i]);
end;

procedure TForm1.AddInEquation(XStart, XEnd, XStep: Double; YFunc: TFunc<Double, Double>;
  AHatchDirection: THatchDirection; AColor: TColor);
var
  i: Double;
  SR1: TLineSeries;
begin
  SR1 := TLineSeries.Create(Chart1);
  SR1.Color := AColor;
  SR1.Pen.Width := 3;
  i := XStart;
  while i <= XEnd do
  begin
    SR1.AddXY(i, YFunc(i));
    i := i + XStep;
  end;
  Chart1.AddSeries(SR1);
  FHatchDirectionList.Add(AHatchDirection);
end;

end.
Остановлюсь на нескольких моментах (этапы реализации):
  1. Первым делом заводим тип штриховки (THatchDirection = (hdUp, hdDown)) и список (FHatchDirectionList: TList), хранящий ее состояния для каждой серии чарта.
  2. Далее, при добавлении серии (неравенства) - AddInEquation (стоит обратить внимание на использование анонимных методов), добавляем тип штриховки.
  3. И, наконец, в методе Chart1.AfterDraw "дорисовываем" к графикам штриховку в нужном направлении (соль - в методе DrawHatch).

Вот результат:



Проект можно воспроизвести, лишь кинув на форму TChart и заменив код формы на приведенный.

Поделитесь с друзьями!

 

Подписчики

Статистика