unit MCAD_MI1201_Chart;

{ Проблемы, которые решает данный модуль:

1. Перерисовка графика (TChart) происходит каждый раз при добавлении точки и/или т.п. -
это происходит слишком часто и ведет к лишней нагрузке на систему.
  Реально перерисовка так часто не нужна, достаточно было бы 1 раз в
100-200 мс.

Решение:
  Данный модуль перхватывает все обращения к процедуре
     Invalidate;
определенной для TWinControl и заменяет их на 1 вызов в
100 мс. Вызов реального Invalidate (приводящий к перерисовке графика)
делается на базе MMTimer.

2. При печати графика (TChart) в Windows NT 4.0 на HP LaserJet не печатаются
линии графиков и сетка.
Решение:
  Линиям должен быть присвоен цвет ЧЕРНЫЙ и толщина 0.

}

interface
  USES Windows, Graphics, MMTimer, Classes, Messages, ExtCtrls,
  TeEngine, Series, TeeProcs, Chart;

type
  tFlag=(fRepaintInProgress, fInvalidateQueued, fRepaint);
  tFlags=set of tFlag;

type
  tGridStorage=record
    Width:integer;
    Color:TColor;
    Style:tPenStyle;
  end;
  tAxisStorage=record
    Grid:tGridStorage;
  end;
  tLineStorage=record
    Series:tLineSeries;
//    Width:integer;
    Color:TColor;
    ColorEachPoint:boolean;
  end;
  tTitleStorage=record
    Color:TColor;
  end;

  tAxisID=(caBottomAxis,caLeftAxis,caTopAxis,caRightAxis);
  tAxies=array[tAxisID] of tAxisStorage;
  tLines=array of tLineStorage;

  tPrintStorage=record
    Mutex:THandle;
    Axies:tAxies;
    Lines:tLines;
    Title:tTitleStorage;
  end;
  tPPrintStorage=^tPrintStorage;

  tPrinterCompatibility=(pcAuto, pcON, pcOff);
  tPrinterCompatibilityOption=(pcoSolidGrids);
  tPrinterCompatibilityOptions=set of tPrinterCompatibilityOption;

resourcestring
  rspconSolidGrids='Сетка сплошными линиями';

const
  cPrinterCompatibilityOptionsMask:tPrinterCompatibilityOptions=[Low(tPrinterCompatibilityOption)..High(tPrinterCompatibilityOption)];
  cPrinterCompatibilityOptionsName:array[tPrinterCompatibilityOption] of string=(
   rspconSolidGrids
  );

type
  TChart = class(Chart.TChart)
   private
    prFlags:tFlags;
    prTimer:tMMTimer;
    prDelayMultiplicator:word;
    prCurCounter:word;
//    prThreadID:dword;
    prPrintStorage:tPPrintStorage;
    prPrinterCompatibility:tPrinterCompatibility;
    prPrinterCompatibilityOptions:tPrinterCompatibilityOptions;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure SetDelayMultiplicator(n:word);
    procedure   DoInvalidate(Sender:tObject);
    // Обработка проблем с печатью
    function PrintAllocateStorage:boolean;
    function PrintFreeStorage:boolean;
    procedure PrintAxisSave(Axis:tChartAxis; var Storage:tAxisStorage);
    procedure PrintAxisRestore(Axis:tChartAxis; const Storage:tAxisStorage);
    procedure PrintLineSave(Series:tLineSeries; var Storage:tLineStorage);
    procedure PrintLineRestore(Series:tLineSeries; const Storage:tLineStorage);
    procedure PrintLinesSave(var Storage:tLines);
    procedure PrintLinesRestore(const Storage:tLines);
    procedure PrintTitleSave(var Storage:tTitleStorage);
    procedure PrintTitleRestore(const Storage:tTitleStorage);
    procedure PrintSaveSettings(var Storage:tPrintStorage);
    procedure PrintRestSettings(const Storage:tPrintStorage);
    function  PrintIsValidDriver:boolean;
    function  PrinterLineCapabilities:integer;
   public
    constructor Create(AOwner:tComponent); override;
    destructor  Destroy; override;
    procedure   Invalidate; override;
    // Увеличение интервала перерисовки в указанное число раз
    property    DelayMultiplicator:word read prDelayMultiplicator write SetDelayMultiplicator;
    // Обработка проблем с печатью
    procedure PrintRectEx(Const R:TRect );
    property  PrinterCompatibility:tPrinterCompatibility read prPrinterCompatibility write prPrinterCompatibility;
    property  PrinterCompatibilityOptions:tPrinterCompatibilityOptions read prPrinterCompatibilityOptions write prPrinterCompatibilityOptions;
  end;

implementation
  USES WinSpool, Printers, Sysutils;

function TChart.PrintIsValidDriver:boolean;
  type PtrDI=^DRIVER_INFO_2;
  const cHP='HP LaserJet';
  var pcbNeeded,pcbSize:dword;
      PrinterHandle:tHandle; s:string;
      pdi:pointer;
begin
if pcAuto = PrinterCompatibility then begin
  pdi:=NIL;
  pcbSize:=0;
  s:=Printer.Printers[Printer.PrinterIndex];
  // Открываем принтер
  Result:=OpenPrinter(PChar(s), PrinterHandle, nil);
  if Result then begin
    // определяем размер буфера под данные
    Result:=GetPrinterDriver(
            PrinterHandle, // printer object
            NIL, // address of environment
            2,  // structure level
            NIL, // address of structure array
            0,	// size, in bytes, of array
            pcbSize 	// address of variable with number of bytes retrieved (or required)
    );
    Result:=not Result and (GetLastError=ERROR_INSUFFICIENT_BUFFER);
    if Result then begin
      try
        GetMem(pdi,pcbSize);
      except
        Result:=FALSE;
      end;
    end;
    if Result then begin
      Result:=GetPrinterDriver(
            PrinterHandle, // printer object
            NIL, // address of environment
            2,  // structure level
            pdi, // address of structure array
            pcbSize,	// size, in bytes, of array
            pcbNeeded 	// address of variable with number of bytes retrieved (or required)
      );
    end;
    ClosePrinter(PrinterHandle);
  end;
  if Result then begin
    Result:=(AnsiStrLIComp(PtrDI(pdi)^.pName, cHP, Length(cHP))=0);
    Result:=Result and (PtrDI(pdi)^.cVersion>2);
  end;
  If Assigned(pdi) then FreeMem(pdi,pcbSize);
end else begin
  Result:=(pcOFF = PrinterCompatibility);
end;
end;

function TChart.PrintAllocateStorage:boolean;
begin
  if not Assigned(prPrintStorage) then begin
    try
      New(prPrintStorage);
      prPrintStorage^.Lines:=NIL;
    except
      PrintFreeStorage;
    end;
  end;
  Result:=Assigned(prPrintStorage);
end;

function TChart.PrintFreeStorage:boolean;
  var h:tHANDLE;
begin
  if Assigned(prPrintStorage) then try
    h:=prPrintStorage^.Mutex;
    prPrintStorage^.Mutex:=0;
    if WaitForSingleObject(h,INFINITE)<>WAIT_TIMEOUT then begin
      CloseHandle(h);
      SetLength(prPrintStorage^.Lines,0);
      Dispose(prPrintStorage);
      prPrintStorage:=NIL;
    end;
  except end;
  Result:=not Assigned(prPrintStorage);
end;

procedure TChart.PrintRectEx(Const R:TRect);
  var h:tHANDLE;
begin
  If PrintIsValidDriver then begin
    PrintRect(R);
  end else if PrintAllocateStorage then begin
    h:=prPrintStorage^.Mutex;
    if WaitForSingleObject(h,INFINITE)<>WAIT_TIMEOUT then begin
      PrintSaveSettings(prPrintStorage^);
      PrintRect(R);
      PrintRestSettings(prPrintStorage^);
      ReleaseMutex(h);
    end;
  end else begin
    PrintRect(R);
  end;
end;

procedure TChart.PrintSaveSettings(var Storage:tPrintStorage);
begin
  PrintAxisSave(BottomAxis, Storage.Axies[caBottomAxis]);
  PrintAxisSave(LeftAxis, Storage.Axies[caLeftAxis]);
  PrintAxisSave(TopAxis, Storage.Axies[caTopAxis]);
  PrintAxisSave(RightAxis, Storage.Axies[caRightAxis]);
  PrintLinesSave(Storage.Lines);
  PrintTitleSave(Storage.Title);
end;

procedure TChart.PrintRestSettings(const Storage:tPrintStorage);
begin
  PrintAxisRestore(BottomAxis, Storage.Axies[caBottomAxis]);
  PrintAxisRestore(LeftAxis, Storage.Axies[caLeftAxis]);
  PrintAxisRestore(TopAxis, Storage.Axies[caTopAxis]);
  PrintAxisRestore(RightAxis, Storage.Axies[caRightAxis]);
  PrintLinesRestore(Storage.Lines);
  PrintTitleRestore(Storage.Title);
end;

procedure TChart.PrintTitleRestore(const Storage:tTitleStorage);
begin
  Title.Font.Color:=Storage.Color;
end;

procedure TChart.PrintTitleSave(var Storage:tTitleStorage);
begin
  Storage.Color:=Title.Font.Color;
  Title.Font.Color:=clBlack;
end;

procedure TChart.PrintLineSave(Series:tLineSeries; var Storage:tLineStorage);
begin
  Series:=Series;
  Storage.Color:=Series.SeriesColor;
  Series.SeriesColor:=clBlack;
  Storage.ColorEachPoint:=Series.ColorEachPoint;
  Series.ColorEachPoint:=FALSE;
//  Storage.Width:=Series.LinePen.Width;
//  Series.LinePen.Width:=1;
end;

procedure TChart.PrintLineRestore(Series:tLineSeries; const Storage:tLineStorage);
begin
  if Series<>Storage.Series then Exit;
  Series.SeriesColor:=Storage.Color;
  Series.ColorEachPoint:=Storage.ColorEachPoint;
//  Series.LinePen.Width:=Storage.Width;
end;

procedure TChart.PrintLinesSave(var Storage:tLines);
  var i,j:integer;
begin
  SetLength(Storage,SeriesCount);
  j:=0;
  for i:=0 to Pred(SeriesCount) do begin
    try
      if Series[i].InheritsFrom(tLineSeries) then begin
        PrintLineSave(tLineSeries(Series[i]),Storage[j]);
        Inc(j);
      end;
    except end;
  end;
  SetLength(Storage,j);
end;

procedure TChart.PrintLinesRestore(const Storage:tLines);
  var i,j,l:integer;
begin
  l:=Length(Storage);
  j:=0;
  for i:=0 to Pred(SeriesCount) do begin
    try
      if Series[i].InheritsFrom(tLineSeries) and (j<l) then begin
        PrintLineRestore(tLineSeries(Series[i]),Storage[j]);
        Inc(j);
      end;
    except end;
  end;
end;

procedure TChart.PrintAxisSave(Axis:tChartAxis; var Storage:tAxisStorage);
//  var pc:integer;
begin
  Storage.Grid.Color:=Axis.Grid.Color;
  Axis.Grid.Color:=clBlack;
  Storage.Grid.Width:=Axis.Grid.Width;
  Axis.Grid.Width:=0;
  Storage.Grid.Style:=Axis.Grid.Style;
//  pc:=PrinterLineCapabilities;
//  if  (pc<>0) and ((PrinterLineCapabilities and LC_WideSTYLED)=0) then
  if pcoSolidGrids in PrinterCompatibilityOptions then
    Axis.Grid.Style:=psSolid;
end;

procedure TChart.PrintAxisRestore(Axis:tChartAxis; const Storage:tAxisStorage);
begin
  Axis.Grid.Color:=Storage.Grid.Color;
  Axis.Grid.Width:=Storage.Grid.Width;
  Axis.Grid.Style:=Storage.Grid.Style;
end;

constructor TChart.Create(AOwner:tComponent);
begin
  Inherited;
  prTimer:=tMMTimer.Create;
  prTimer.Interval:=133;
  prTimer.Resolution:=300;
  prTimer.TimerType:=ttPeriodic;
  prTimer.OnTimer:=DoInvalidate;
  prTimer.Enabled:=TRUE;
//  prThreadID:=GetCurrentThreadId;
end;

destructor TChart.Destroy;
begin
  prTimer.Free;
  PrintFreeStorage;
  Inherited;
end;

procedure TChart.WMPaint(var Message: TWMPaint);
begin
  if fRepaintInProgress in prFlags then begin
    Exclude(prFlags,fRepaintInProgress);
    Inherited;
    Exclude(prFlags,fInvalidateQueued);
  end else begin
    prCurCounter:=0;
    Invalidate;
  end;
end;

procedure TChart.Invalidate;
begin
  Include(prFlags,fInvalidateQueued);
end;

procedure TChart.DoInvalidate(Sender:tObject);
begin
  if prCurCounter>0 then begin
    Dec(prCurCounter);
  end else if (fInvalidateQueued in prFlags) and not (fRepaintInProgress in prFlags) then begin
    Include(prFlags,fRepaintInProgress);
    Inherited Invalidate;
    prCurCounter:=prDelayMultiplicator;
  end;
end;

procedure TChart.SetDelayMultiplicator(n:word);
begin
  prDelayMultiplicator:=n;
  if prCurCounter>n then begin
    prCurCounter:=n;
  end;
end;

function  TChart.PrinterLineCapabilities:integer;
begin
  PrinterLineCapabilities:=GetDeviceCaps(Printer.Handle,LINECAPS);
end;

end.