Вверх ↑
Этот топик читают: Гость
Ответов: 16884
Рейтинг: 1239
#1: 2017-05-05 07:16:24 ЛС | профиль | цитата
Схема


Add(MainForm,2953706,154,105)
{
 Width=428
 Height=441
}
Add(ChildGroupBox,7224576,252,105)
{
}
BEGIN_SDK
  Add(EditMulti,7412133,7,7)
  {
   WorkCount=1
   Width=195
   Height=165
   VOffset=28
   link(doWork1,5837163:doEvent1,[])
  }
  Add(GroupBox,2618308,28,84)
  {
   Left=35
   Top=55
   Width=240
   Height=150
   Font=[MS Sans Serif,8,1,16711680,1]
   Ctl3D=0
   WinStyle=1
   Caption="ГРАФИК"
   Point(Handle)
   Point(doCaption)
  }
  Add(PaintBox,13607343,140,28)
  {
   Width=245
   Height=150
   Point(Width)
   Point(Height)
   Point(doVisible)
  }
  Add(Img_Diagram,10381908,133,126)
  {
   Point1=1
   Point2AsOffset=0
   Style=2
   Color=16777215
   BgColor=65280
   BgColors=['Питание'=12672767,'Транспорт'=8294280,'Платежи'=15413896,'Дети'=14667846,'Быт.расходы'=16744014]
   Font=[Courier New,8,1,8388608,204]
   Items=#7:Питание|9:Транспорт|7:Платежи|4:Дети|9:Быт.расх.|
   LegendSize=100
   ShowZero=1
   Point(Point1)
   Point(Point2)
   link(onDraw,13607343:doRefresh,[(189,132)(189,16)(128,16)(128,34)])
   link(Bitmap,13607343:Bitmap,[(139,79)(146,79)])
   link(Point2,8882345:Point,[])
  }
  Add(PointXY,8882345,147,77)
  {
   link(X,13607343:Width,[])
   link(Y,13607343:Height,[])
  }
  Add(Hub,5837163,28,35)
  {
   OutCount=3
   link(onEvent1,13607343:doClear,[])
   link(onEvent2,4848606:doAdd,[(66,48)(66,132)])
  }
  Add(MT_AddData,4848606,77,126)
  {
   Count=5
   Data=Integer(0)
   link(onAdd,10381908:doDraw,[])
  }
  Add(VisualStrings,14563985,91,77)
  {
   Lines=#3:100|
  }
END_SDK
Add(Button,14137115,203,105)
{
 Left=10
 Top=20
 link(onClick,7224576:doWork1,[])
}

nesco, у себя добавил строку

   sum := 0;
   SetLength(items, FList.Count);
   for i := 0 to FList.Count-1 do
    begin
      Items[i] := ToReal(mt);
      if mt.ldata ‹› nil then
        mt := mt.ldata^;
        
      sum := sum + items[i];  
    end; 
   IF SUM=0 THEN EXIT; // 05.05.2017 Tad

карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
1
Голосовали:sla8a
Разработчик
Ответов: 26264
Рейтинг: 2140
#2: 2017-05-05 09:48:20 ЛС | профиль | цитата
Пофиксил
карма: 22

0
Ответов: 16884
Рейтинг: 1239
#3: 2017-05-06 10:55:48 ЛС | профиль | цитата
nesco, мало. Нужна ещё и перерисовка
Вот так вроде нормально работает:

// 05.05.2017 Tad
IF SUM=0 THEN begin  
 _hi_CreateEvent(_Data,@_event_onDraw,0); 
 EXIT; 
end; // 05.05.2017 Tad
карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#4: 2017-05-06 11:32:09 ЛС | профиль | цитата
Tad, лучше сделать по другому. Вот это точно нельзя:
Tad писал(а):
_hi_CreateEvent(_Data,@_event_onDraw,0);
Должно быть dt
Предложу следующее:
 if sum > 0 then//добавить это
  begin//вот это
   if _prop_LegendShow then//оставить не тронутым все от сюда
   ...
   ...
   ...
   DeleteObject(Pen);//до сюда
  end;//добавим это
  ImgReleaseDC; 
 _hi_CreateEvent(_Data,@_event_onDraw,dt);//а это уже и так есть. 
В результате event_onDraw произойдет в любом случае и передаст в поток данные dt, а рисовать не будет (и не выдаст ошибку) если sum меньше нуля. Вроде все логично.

Редактировалось 3 раз(а), последний 2017-05-06 12:24:23
карма: 11

0
Ответов: 16884
Рейтинг: 1239
#5: 2017-05-06 12:01:32 ЛС | профиль | цитата
sla8a писал(а):
Вот это точно нельзя:
A это ещё почему ?
Share.pas писал(а):

// ##_hi_CreateEvent
procedure _hi_CreateEvent_(var _Data:TData; Event:PHI_Event); overload; 
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const Data:TData); overload;
//=========================================================================================
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; Data:integer); overload;
//=========================================================================================
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; Data:real); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const Data:string); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const Data:PStream); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const Data:PBitmap); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const Data:PType); overload;
procedure _hi_CreateEvent(var _Data:TData; Event:PHI_Event; const ID:Integer; const Data:Pointer); overload;


Редактировалось 2 раз(а), последний 2017-05-06 12:04:03
карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#6: 2017-05-06 12:06:15 ЛС | профиль | цитата
Tad писал(а):
A это ещё почему ?

sla8a писал(а):
Должно быть dt

Tad, во всех элементах графики в начале копируются входные данные (dt):
   dt := _Data;
а в после отрисовки выдает эти данные обратно в поток:
   _hi_CreateEvent(_Data,@_event_onDraw,dt);

nesco, еще нужно поставить TRY,FINALLY,END. Откройте любой элемент графики (к примеру Img_Line) и сделайте также. А то
if not ImgGetDC(_Data) then exit;
делает такое:
схемка

Add(MainForm,2953706,42,175)
{
 Width=611
 Height=424
}
Add(PaintBox,1364620,336,140)
{
 Left=140
 Top=105
 Width=155
 Height=150
 Color=12639424
 link(onBeforeDraw,9205656:doDraw,[(380,146)(380,188)(324,188)(324,230)])
}
Add(Img_Rectangle,9205656,336,224)
{
 Point1=5
 Point2=2621470
 link(onDraw,2331832:doDraw,[])
 link(Bitmap,2290781:Var2,[])
}
Add(Img_Diagram,2331832,385,224)
{
 BgColors=[]
 Point(Point1)
 Point(Point2)
 link(onDraw,11297991:doEvent,[])
}
Add(Img_Rectangle,16591304,448,224)
{
 @Hint=#82:Прямоугольник не рисуется. Причина: точка bitmap элемента Диаграмма НЕ подключена.|
 Point1=120
 Point2=2621470
 link(Bitmap,2290781:Var3,[(454,194)])
 AddHint(47,-80,166,39,@Hint)
}
Add(GetDataEx,2290781,336,189)
{
 link(Data,1364620:Bitmap,[])
}
Add(Debug,11297991,427,224)
{
 link(onEvent,16591304:doDraw,[])
}

Редактировалось 1 раз(а), последний 2017-05-06 12:17:52
карма: 11

0
Ответов: 16884
Рейтинг: 1239
#7: 2017-05-06 12:22:12 ЛС | профиль | цитата
есть данные
нет данных
карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#8: 2017-05-06 12:30:11 ЛС | профиль | цитата
Tad, как с вами бывает тяжело. Прочитайте еще раз мои посты выше и если не понятно, то задайте конкретный вопрос.
карма: 11

0
Ответов: 16884
Рейтинг: 1239
#9: 2017-05-06 12:45:16 ЛС | профиль | цитата
Ты бы ещё знал какую фигню выдает Img_Diagram при получении отрицательных чисел.

Редактировалось 1 раз(а), последний 2017-05-06 12:45:48
карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#10: 2017-05-06 12:59:53 ЛС | профиль | цитата
nesco, лучше наверное вообще ничего не создавать если данных нет:
hiImg_Diagram.pas

unit hiImg_Diagram;

interface

uses windows,Kol,Share,Debug,Img_Draw;

const
  bsManual = bsCross;

type
  THIImg_Diagram = class(THIImg)
   private
    FList:PStrList;
    GFont   : PGraphicTool;

    procedure SetNewFont(Value:TFontRec);
    procedure SetItems(const value:string);
   public
    _data_Data:THI_Event;
    _prop_TitleMask:string;
    _prop_BgColor:TColor;
    _prop_LegendShow:boolean;
    _prop_LegendSize:integer;
    _prop_BgColors:PStrListEx;
    _prop_ShowZero:boolean;
        
    destructor Destroy; override;
    procedure _work_doDraw(var _Data:TData; Index:word);
    procedure _work_doItems(var _Data:TData; Index:word);
    property _prop_Items:string write SetItems;
    property _prop_Font:TFontRec write SetNewFont;
  end;

implementation

destructor THIImg_Diagram.Destroy;
begin
  FList.Free; 
  inherited;
end;

procedure THIImg_Diagram.SetNewFont;
begin
   if Assigned(GFont) then GFont.free;
   GFont := NewFont;
   GFont.Color:= Value.Color;
   Share.SetFont(GFont,Value.Style);
   GFont.FontName:= Value.Name;
   GFont.FontHeight:= _hi_SizeFnt(Value.Size);
   GFont.FontCharset:= Value.CharSet;
end;

procedure THIImg_Diagram.SetItems(const value:string);
begin
  FList := NewStrList;
  FList.Text := value;
end;

procedure THIImg_Diagram._work_doItems;
begin
  SetItems(ToString(_Data));
end;

procedure THIImg_Diagram._work_doDraw(var _Data:TData; Index:word);
var
   dt,mt: TData;
   br, oldb: HBRUSH;
   pen: HPEN;
   i,rx,ry,fh:integer;
   sum,a,ra,per:real;
   items:array of real;
   x3,y3,x4,y4:integer;
   hOldFont: HFONT;
   SizeFont: TSize;
   s:string;
   BgColor:TRGB;
   _r,_g,_b:real;
begin
   dt := _Data;
TRY
   if not ImgGetDC(_Data) then exit;
   ReadXY(_Data);

   mt := ReadMTData(_Data, _data_Data);

   sum := 0;
   SetLength(items, FList.Count);
   for i := 0 to FList.Count-1 do
    begin
      Items[i] := ToReal(mt);
      if mt.ldata <> nil then
        mt := mt.ldata^;
        
      sum := sum + items[i];  
    end; 

   if sum > 0 then// 05.05.2017 Tad
   begin 
    ImgNewSizeDC;
    pen := CreatePen(ord(_prop_LineStyle), Round((fScale.x + fScale.y) * ReadInteger(_Data,_data_Size,_prop_Size)/2), Color2RGB(ReadInteger(_Data,_data_Color,_prop_Color)));
    SelectObject(pDC,Pen);
    
    fh := GFont.FontHeight;
    GFont.FontHeight := Round(GFont.FontHeight * fScale.y);
    hOldFont := SelectObject(pDC, GFont.Handle);   

    if _prop_LegendShow then
     dec(x2, Round(_prop_LegendSize * fScale.x));
   
    rx := (x2-x1) div 2;
    ry := (y2-y1) div 2;
    x3 := x2;
    y3 := y1 + ry;
    a := 0;
    
    BgColor := TRGB(Color2RGB(_prop_BgColor));
    _r := (BgColor.r - 40) / FList.Count;   
    _g := (BgColor.g - 40) / FList.Count;
    _b := (BgColor.b - 40) / FList.Count;
    for i := 0 to FList.Count-1 do
     begin
       if _prop_Style = bsSolid then
         br := CreateSolidBrush(RGB(Round(BgColor.r - _r*i), Round(BgColor.g - _g*i), Round(BgColor.b - _b*i)))
       else if _prop_Style = bsManual then
         br := CreateSolidBrush(Color2RGB(integer(_prop_BgColors.Objects[i])))
       else
         br := GetStockObject(NULL_BRUSH);
       
       oldb := SelectObject(pDC,br);
      
       if items[i] > 0 then
         begin 
          a := a + items[i]/sum*2*pi;
          x4 := x1 + rx + Round(rx*cos(a));
          y4 := y1 + ry + Round(-ry*sin(a));  
          Pie(pDC, x1, y1, x2, y2, x3, y3, x4, y4);
          x3 := x4;
          y3 := y4;
         end;
       if _prop_LegendShow then              
         Rectangle(pDC, x2 + Round(5 * fScale.x), Round((10 + i*24) * fScale.y), x2 + Round(25 * fScale.x), Round((30 + i*24) * fScale.y));
       SelectObject(pDC,oldb);
       DeleteObject(br);
     end;   

    a := 0;
    SetBkMode(pDC, TRANSPARENT);
    SetTextColor(pDC, Color2RGB(GFont.Color));   
    for i := 0 to FList.Count-1 do
     begin
       per := Round(items[i]/sum*1000)/10; 
       s := _prop_TitleMask;
       Replace(s, '%name%', FList.items[i]); 
       Replace(s, '%val%', double2str(items[i]));
       Replace(s, '%per%', double2str(per));

       GetTextExtentPoint32(pDC, PChar(s), Length(s), SizeFont);

       ra := items[i]/sum*2*pi;
       a := a + ra;
       x4 := x1 + rx + Round(rx/2*cos(a - ra/2)) - SizeFont.cx div 2;
       y4 := y1 + ry + Round(-ry/2*sin(a - ra/2)) - SizeFont.cy div 2;
      
       if x4 < 0 then x4 := 1
       else if x4 > x2 - SizeFont.cx then x4 := x2 - SizeFont.cx - 1;   
       if y4 < 0 then y4 := 1
       else if y4 > y2 - SizeFont.cy then y4 := y2 - SizeFont.cy - 1;
       if _prop_ShowZero or(per > 0)then 
         TextOut(pDC, x4, y4, PChar(s), Length(s));
       if _prop_LegendShow then
         TextOut(pDC, x2 + Round(30 * fScale.x), Round((12 + i*24) * fScale.y), PChar(FList.items[i]), Length(FList.items[i]));
     end;  
    SelectObject(pDC, hOldFont);
    GFont.FontHeight := fh;
    DeleteObject(Pen);
   end;
FINALLY
    ImgReleaseDC;
   _hi_CreateEvent(_Data,@_event_onDraw,dt);
END;
end;

end.
Tad, вы ему еще строки подайте, пусть подавится.

Редактировалось 4 раз(а), последний 2017-05-06 13:10:56
карма: 11

0
Ответов: 16884
Рейтинг: 1239
#11: 2017-05-06 13:39:29 ЛС | профиль | цитата
sla8a,
sla8a, пож. проверь со своими правками


Add(MainForm,2953706,56,112)
{
 Width=494
 Height=303
}
Add(ChildGroupBox,7224576,154,119)
{
}
BEGIN_SDK
  Add(EditMulti,7412133,7,7)
  {
   WorkCount=1
   Width=251
   Height=165
   VOffset=28
   link(doWork1,5837163:doEvent1,[])
  }
  Add(GroupBox,2618308,28,84)
  {
   Left=220
   Top=15
   Width=240
   Height=150
   Font=[MS Sans Serif,8,1,16711680,1]
   Ctl3D=0
   WinStyle=1
   Caption="ГРАФИК"
   Point(Handle)
   Point(doCaption)
  }
  Add(PaintBox,13607343,182,28)
  {
   Width=245
   Height=150
   Point(Width)
   Point(Height)
   Point(doVisible)
  }
  Add(Img_Diagram,10381908,175,126)
  {
   Point1=1
   Point2AsOffset=0
   Style=2
   Color=16777215
   BgColor=65280
   BgColors=['Питание'=12672767,'Транспорт'=8294280,'Платежи'=15413896,'Дети'=14667846,'Быт.расходы'=16744014]
   Font=[MS Sans Serif,8,1,8388608,1]
   Items=#7:Питание|9:Транспорт|7:Платежи|4:Дети|9:Быт.расх.|
   LegendSize=100
   ShowZero=1
   Point(Point1)
   Point(Point2)
   link(onDraw,13607343:doRefresh,[(231,132)(231,16)(170,16)(170,34)])
   link(Bitmap,13607343:Bitmap,[(181,79)(188,79)])
   link(Point2,8882345:Point,[])
  }
  Add(PointXY,8882345,189,77)
  {
   link(X,13607343:Width,[])
   link(Y,13607343:Height,[])
  }
  Add(Hub,5837163,28,35)
  {
   OutCount=3
   link(onEvent1,13607343:doClear,[])
   link(onEvent2,3399627:doMT,[(63,48)(63,139)])
  }
  Add(MT_String,3399627,84,126)
  {
   link(onResult,10381908:doDraw,[])
  }
END_SDK
Add(ListBox,5222057,105,112)
{
 Left=30
 Top=15
 Width=185
 Height=240
 Strings=#9:0;1;2;3;4|15:20;100;12;12;45|14:10;20;30;40;50|15:0;220;570;0;100|9:0;0;0;0;0|17:-20;-30;45;55;200|
 DataType=1
 link(onClick,7224576:doWork1,[])
}

карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#12: 2017-05-06 13:57:03 ЛС | профиль | цитата
Tad, вроде все работает. Проверку на отрицательные числа думаю не нужно делать. А вот вывод диаграммы при [0,0,0,0,0] думаю можно сделать. По вашему что должно быть изображено в таком случае?
карма: 11

0
Ответов: 16884
Рейтинг: 1239
#13: 2017-05-06 14:09:43 ЛС | профиль | цитата
sla8a писал(а):
А вот вывод диаграммы при [0,0,0,0,0] думаю можно сделать.
Да думаю просто диаграмма должна исчезать.
sla8a писал(а):
Проверку на отрицательные числа думаю не нужно делать.
А вот, что с ними делать - никаких мыслей.
Наверное придётся их блокировать при вводе
карма: 25
Немного терпения! Дежурный экстрасенс скоро свяжется с Вами!
0
Ответов: 2370
Рейтинг: 683
#14: 2017-05-06 14:18:48 ЛС | профиль | цитата
Tad писал(а):
Да думаю просто диаграмма должна исчезать.
А если пустой круг с надписью нет данных?
Tad писал(а):
Наверное придётся их блокировать при вводе
Так и надо делать.

--- Добавлено в 2017-05-06 14:36:55

nodata.PNG

--- Добавлено в 2017-05-06 14:50:19

Можно это протестировать:
hiImg_Diagram.pas


unit hiImg_Diagram;

interface

uses windows,Kol,Share,Debug,Img_Draw;

const
  bsManual = bsCross;

type
  THIImg_Diagram = class(THIImg)
   private
    FList:PStrList;
    GFont   : PGraphicTool;

    procedure SetNewFont(Value:TFontRec);
    procedure SetItems(const value:string);
   public
    _data_Data:THI_Event;
    _prop_TitleMask:string;
    _prop_BgColor:TColor;
    _prop_LegendShow:boolean;
    _prop_LegendSize:integer;
    _prop_BgColors:PStrListEx;
    _prop_ShowZero:boolean;
        
    destructor Destroy; override;
    procedure _work_doDraw(var _Data:TData; Index:word);
    procedure _work_doItems(var _Data:TData; Index:word);
    property _prop_Items:string write SetItems;
    property _prop_Font:TFontRec write SetNewFont;
  end;

implementation

destructor THIImg_Diagram.Destroy;
begin
  FList.Free; 
  inherited;
end;

procedure THIImg_Diagram.SetNewFont;
begin
   if Assigned(GFont) then GFont.free;
   GFont := NewFont;
   GFont.Color:= Value.Color;
   Share.SetFont(GFont,Value.Style);
   GFont.FontName:= Value.Name;
   GFont.FontHeight:= _hi_SizeFnt(Value.Size);
   GFont.FontCharset:= Value.CharSet;
end;

procedure THIImg_Diagram.SetItems(const value:string);
begin
  FList := NewStrList;
  FList.Text := value;
end;

procedure THIImg_Diagram._work_doItems;
begin
  SetItems(ToString(_Data));
end;

procedure THIImg_Diagram._work_doDraw(var _Data:TData; Index:word);
var
   dt,mt: TData;
   br, oldb: HBRUSH;
   pen: HPEN;
   i,rx,ry,fh:integer;
   sum,a,ra,per:real;
   items:array of real;
   x3,y3,x4,y4:integer;
   hOldFont: HFONT;
   SizeFont: TSize;
   s:string;
   BgColor:TRGB;
   _r,_g,_b:real;
begin
   dt := _Data;
TRY
   if not ImgGetDC(_Data) then exit;
   ReadXY(_Data);

   mt := ReadMTData(_Data, _data_Data);

   sum := 0;
   SetLength(items, FList.Count);
   for i := 0 to FList.Count-1 do
    begin
      Items[i] := ToReal(mt);
      if Items[i] < 0 then
       Items[i] := 0;//íèêàêèõ îòðèöàòåëüíûõ ÷èñåë
      if mt.ldata <> nil then
       mt := mt.ldata^;
      sum := sum + items[i];  
    end; 
    ImgNewSizeDC;
    pen := CreatePen(ord(_prop_LineStyle), Round((fScale.x + fScale.y) * ReadInteger(_Data,_data_Size,_prop_Size)/2), Color2RGB(ReadInteger(_Data,_data_Color,_prop_Color)));
    SelectObject(pDC,Pen);
    
    fh := GFont.FontHeight;
    GFont.FontHeight := Round(GFont.FontHeight * fScale.y);
    hOldFont := SelectObject(pDC, GFont.Handle);   

    if _prop_LegendShow then
     dec(x2, Round(_prop_LegendSize * fScale.x));
   
    rx := (x2-x1) div 2;
    ry := (y2-y1) div 2;
    x3 := x2;
    y3 := y1 + ry;
    a := 0;
    
    BgColor := TRGB(Color2RGB(_prop_BgColor));
    _r := (BgColor.r - 40) / FList.Count;   
    _g := (BgColor.g - 40) / FList.Count;
    _b := (BgColor.b - 40) / FList.Count;
    
   if sum <= 0 then
    begin
     for i := 0 to FList.Count-1 do
      begin
       Items[i] := 0;
       sum := 1;
      end;
     Ellipse(pDC, x1, y1, x2, y2);
     s := 'íåò äàííûõ';
     GetTextExtentPoint32(pDC, PChar(s), Length(s), SizeFont);
     TextOut(pDC, x1 + x2 div 2 - SizeFont.cx div 2, y1 + y2 div 2 - SizeFont.cy div 2, PChar(s), Length(s));
    end;

    for i := 0 to FList.Count-1 do
     begin
       if _prop_Style = bsSolid then
         br := CreateSolidBrush(RGB(Round(BgColor.r - _r*i), Round(BgColor.g - _g*i), Round(BgColor.b - _b*i)))
       else if _prop_Style = bsManual then
         br := CreateSolidBrush(Color2RGB(integer(_prop_BgColors.Objects[i])))
       else
         br := GetStockObject(NULL_BRUSH);
       
       oldb := SelectObject(pDC,br);
      
       if items[i] > 0 then
         begin 
          a := a + items[i]/sum*2*pi;
          x4 := x1 + rx + Round(rx*cos(a));
          y4 := y1 + ry + Round(-ry*sin(a));  
          Pie(pDC, x1, y1, x2, y2, x3, y3, x4, y4);
          x3 := x4;
          y3 := y4;
         end;
       if _prop_LegendShow then              
         Rectangle(pDC, x2 + Round(5 * fScale.x), Round((10 + i*24) * fScale.y), x2 + Round(25 * fScale.x), Round((30 + i*24) * fScale.y));
       SelectObject(pDC,oldb);
       DeleteObject(br);
     end;   

    a := 0;
    SetBkMode(pDC, TRANSPARENT);
    SetTextColor(pDC, Color2RGB(GFont.Color));   
    for i := 0 to FList.Count-1 do
     begin
       per := Round(items[i]/sum*1000)/10; 
       s := _prop_TitleMask;
       Replace(s, '%name%', FList.items[i]); 
       Replace(s, '%val%', double2str(items[i]));
       Replace(s, '%per%', double2str(per));

       GetTextExtentPoint32(pDC, PChar(s), Length(s), SizeFont);

       ra := items[i]/sum*2*pi;
       a := a + ra;
       x4 := x1 + rx + Round(rx/2*cos(a - ra/2)) - SizeFont.cx div 2;
       y4 := y1 + ry + Round(-ry/2*sin(a - ra/2)) - SizeFont.cy div 2;
      
       if x4 < 0 then x4 := 1
       else if x4 > x2 - SizeFont.cx then x4 := x2 - SizeFont.cx - 1;   
       if y4 < 0 then y4 := 1
       else if y4 > y2 - SizeFont.cy then y4 := y2 - SizeFont.cy - 1;
       if _prop_ShowZero or(per > 0)then 
         TextOut(pDC, x4, y4, PChar(s), Length(s));
       if _prop_LegendShow then
         TextOut(pDC, x2 + Round(30 * fScale.x), Round((12 + i*24) * fScale.y), PChar(FList.items[i]), Length(FList.items[i]));
     end;  

    SelectObject(pDC, hOldFont);
    GFont.FontHeight := fh;
    DeleteObject(Pen);
FINALLY
    ImgReleaseDC;
   _hi_CreateEvent(_Data,@_event_onDraw,dt);
END;
end;

end.

-Пустая диаграмма при пустых данных.
-Отсутствие фигни при отрицательных значения в данных.

Редактировалось 2 раз(а), последний 2017-05-06 14:50:19
карма: 11

0
Разработчик
Ответов: 26264
Рейтинг: 2140
#15: 2017-05-06 15:21:05 ЛС | профиль | цитата
Короче, приходите к консенсусу и выкладывайте здесь правленый вариант для добавления на SVN
карма: 22

0
Сообщение
...
Прикрепленные файлы
(файлы не залиты)