1
0
mirror of https://bitbucket.org/Dennis07/lina-components.git synced 2025-02-12 10:25:59 +02:00

Version 1.0 DEV 1.16c

Signed-off-by: Dennis07 <den.goehlert@t-online.de>
This commit is contained in:
Dennis07 2017-05-26 21:49:32 +02:00
parent f0d57e3927
commit c5268b9088
14 changed files with 426 additions and 72 deletions

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -13,7 +13,7 @@ interface
uses
{ Standard-Units }
SysUtils, Classes, Controls, Windows, Forms, StdCtrls, ComCtrls, ExtCtrls,
Graphics, Dialogs,
Graphics, Dialogs, Messages,
{ Andere Package-Units }
uBase, uSysTools, uSysCtrls, uWebCtrls;
@ -486,7 +486,6 @@ type
FColor: TColor;
FValue: Integer;
FVIsible: Boolean;
FArtLine: Boolean;
FBorderStyle: TBorderStyle;
FBorderWidth: Integer;
FBorderColor: TColor;
@ -495,7 +494,6 @@ type
procedure SetColor(Value: TColor);
procedure SetValue(Value: Integer);
procedure SetVisible(Value: Boolean);
procedure SetArtLine(Value: Boolean);
procedure SetBorderStyle(Value: TBorderStyle);
procedure SetBorderWidth(Value: Integer);
procedure SetBorderColor(Value: TColor);
@ -510,7 +508,6 @@ type
property Color: TColor read FColor write SetColor default clNone;
property Value: Integer read FValue write SetValue default 0;
property Visible: Boolean read FVIsible write SetVisible default True;
property ArtLine: Boolean read FArtLine write SetArtLine default False;
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 1;
property BorderColor: TColor read FBorderColor write SetBorderColor default clNone;
@ -530,6 +527,58 @@ type
function AvgValue: Integer;
function First: Integer;
function Last: Integer;
function VisibleCount: Integer;
end;
TDiagramScaleValueArtLines = class(TPersistent)
private
{ Private-Deklarationen }
FDiagram: TDiagram;
FVisible: Boolean;
FColor: TColor;
FWidth: Integer;
FDotted: Boolean;
{ Methoden }
procedure SetVisible(Value: Boolean);
procedure SetColor(Value: TColor);
procedure SetWidth(Value: Integer);
procedure SetDotted(Value: Boolean);
public
{ Public-Deklarationen }
constructor Create(ADiagram: TDiagram);
destructor Destroy; override;
published
{ Published-Deklarationen }
property Visible: Boolean read FVisible write SetVisible default False;
property Color: TColor read FColor write SetColor default clDkGray;
property Width: Integer read FWidth write SetWidth default 1;
property Dotted: Boolean read FDotted write SetDotted default True;
end;
TDiagramScaleCursorArtLines = class(TDiagramScaleValueArtLines)
public
{ Public-Deklarationen }
constructor Create(ADiagram: TDiagram);
destructor Destroy; override;
published
{ Published-Deklarationen }
property Dotted: Boolean read FDotted write SetDotted default False;
end;
TDiagramScaleArtLines = class(TPersistent)
private
{ Private-Deklarationen }
FDiagram: TDiagram;
FValues: TDiagramScaleValueArtLines;
FCursor: TDiagramScaleCursorArtLines;
public
{ Public-Deklarationen }
constructor Create(ADiagram: TDiagram);
destructor Destroy; override;
published
{ Published-Deklarationen }
property Values: TDiagramScaleValueArtLines read FValues write FValues;
property Cursor: TDiagramScaleCursorArtLines read FCursor write FCursor;
end;
TDiagramScaleBar = class(TPersistent)
@ -620,6 +669,7 @@ type
private
{ Private-Deklarationen }
FDiagram: TDiagram;
FArtLines: TDiagramScaleArtLines;
FBar: TDiagramScaleBar;
FGrid: TDiagramScaleGrid;
FValues: TDiagramScaleValues;
@ -629,6 +679,7 @@ type
destructor Destroy; override;
published
{ Published-Deklarationen }
property ArtLines: TDiagramScaleArtlines read FArtLines write FArtLines;
property Bar: TDiagramScaleBar read FBar write FBar;
property Grid: TDiagramScaleGrid read FGrid write FGrid;
property Values: TDiagramScaleValues read FValues write FValues;
@ -659,6 +710,31 @@ type
property VerticalAlignment: TVerticalAlignment read FVerticalAlignment write SetVerticalAlignment default taAlignTop;
end;
TDiagramAutoColors = class(TPersistent)
private
{ Private-Deklarationen }
FDiagram: TDiagram;
FEnabled: Boolean;
FPositive: TColor;
FZero: TColor;
FNegative: TColor;
{ Methoden }
procedure SetEnabled(Value: Boolean);
procedure SetPositive(Value: TColor);
procedure SetZero(Value: TColor);
procedure SetNegative(Value: TColor);
public
{ Public-Deklarationen }
constructor Create(ADiagram: TDiagram);
destructor Destroy; override;
published
{ Published-Deklarationen }
property Enabled: Boolean read FEnabled write SetEnabled default False;
property Positive: TColor read FPositive write SetPositive default clBlue;
property Zero: TColor read FZero write SetZero default clWhite;
property Negative: TColor read FNegative write SetNegative default clRed;
end;
{$IFNDEF NO_MULTIPLATFORM}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
@ -671,7 +747,7 @@ type
FValues: TDiagramValues;
FPadding: TDiagramPadding;
FScale: TDiagramScale;
FAutoColor: Boolean;
FAutoColors: TDiagramAutoColors;
FAlignment: TAlignment;
{ Ereignisse }
FDrawValueEvent: TDiagramDrawValueEvent;
@ -682,19 +758,19 @@ type
procedure SetValues(Value: TDiagramValues);
procedure SetPadding(Value: TDiagramPadding);
procedure SetScale(Value: TDiagramScale);
procedure SetAutoColor(Value: Boolean);
procedure PropertyChange(Sender: TObject);
protected
{ Protected-Deklarationen }
procedure Paint; override;
procedure DrawBackground;
procedure DrawCaption;
procedure DrawBar;
procedure DrawGrid;
procedure DrawValue(Index: Integer);
procedure DrawColumn(Index: Integer);
procedure DrawPoint(Index: Integer);
procedure DrawLine(Index: Integer);
procedure DrawBackground; virtual;
procedure DrawCaption; virtual;
procedure DrawBar; virtual;
procedure DrawGrid; virtual;
procedure DrawValueArtLines; virtual;
procedure DrawCursorArtLines; virtual;
procedure DrawValue(Index: Integer); virtual;
procedure DrawColumn(Index: Integer); virtual;
procedure DrawPoint(Index: Integer); virtual;
procedure DrawLine(Index: Integer); virtual;
function ZeroWidth: Integer;
function ZeroHeight: Integer;
function ValueHeight(Value: Integer): Integer;
@ -702,6 +778,10 @@ type
function ValueLeft(Index: Integer): Integer;
function ValueWidth: Integer;
function ValueSpace: Integer;
procedure PropertyChange(Sender: TObject);
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
@ -745,7 +825,7 @@ type
property Values: TDiagramValues read FValues write SetValues;
property Padding: TDiagramPadding read FPadding write SetPadding;
property Scale: TDiagramScale read FScale write SetScale;
property AutoColor: Boolean read FAutoColor write SetAutoColor default False;
property AutoColors: TDiagramAutoColors read FAutoColors write FAutoColors;
end;
{ ShowMessage-Varianten }
@ -2150,7 +2230,7 @@ end;
destructor TDiagramPadding.Destroy;
begin
FDiagram := nil;
//...
inherited;
end;
@ -2195,7 +2275,6 @@ begin
FColor := clNone;
FValue := 0;
FVisible := True;
FArtLine := False;
FBorderStyle := bsSingle;
FBorderWidth := 1;
FBorderColor := clNone;
@ -2231,12 +2310,6 @@ begin
(Collection as TDiagramValues).FDiagram.Repaint;
end;
procedure TDiagramValue.SetArtLine(Value: Boolean);
begin
FArtLine := Value;
(Collection as TDiagramValues).FDiagram.Repaint;
end;
procedure TDiagramValue.SetBorderStyle(Value: TBorderStyle);
begin
FBorderStyle := Value;
@ -2258,7 +2331,7 @@ end;
function TDiagramValue.GetDisplayName: String;
begin
inherited;
Result:= FName;
Result:= FName + ' (' + IntToStr(FValue) + ')';
end;
{ ----------------------------------------------------------------------------
@ -2273,7 +2346,7 @@ end;
destructor TDiagramValues.Destroy;
begin
FDiagram := nil;
//...
inherited;
end;
@ -2358,7 +2431,99 @@ begin
Exit;
end;
end;
Result := -1;
end;
function TDiagramValues.VisibleCount: Integer;
var
Index: Integer;
begin
Result := 0;
for Index := 0 to Count - 1 do
begin
if (Items[Index] as TDiagramValue).Visible then
begin
Inc(Result);
end;
end;
end;
{ ----------------------------------------------------------------------------
TDiagramScaleValueArtLines
---------------------------------------------------------------------------- }
constructor TDiagramScaleValueArtLines.Create(ADiagram: TDiagram);
begin
inherited Create;
FDiagram := ADiagram;
FVisible := False;
FColor := clDkGray;
FWidth := 1;
FDotted := True;
end;
destructor TDiagramScaleValueArtLines.Destroy;
begin
//...
inherited;
end;
procedure TDiagramScaleValueArtLines.SetVisible(Value: Boolean);
begin
FVisible := Value;
FDiagram.Repaint;
end;
procedure TDiagramScaleValueArtLines.SetColor(Value: TColor);
begin
FColor := Value;
FDiagram.Repaint;
end;
procedure TDiagramScaleValueArtLines.SetWidth(Value: Integer);
begin
FWidth := Value;
FDiagram.Repaint;
end;
procedure TDiagramScaleValueArtLines.SetDotted(Value: Boolean);
begin
FDotted := Value;
FDiagram.Repaint;
end;
{ ----------------------------------------------------------------------------
TDiagramScaleCursorArtLines
---------------------------------------------------------------------------- }
constructor TDiagramScaleCursorArtLines.Create(ADiagram: TDiagram);
begin
inherited;
FDotted := False;
end;
destructor TDiagramScaleCursorArtLines.Destroy;
begin
//...
inherited;
end;
{ ----------------------------------------------------------------------------
TDiagramScaleArtLines
---------------------------------------------------------------------------- }
constructor TDiagramScaleArtLines.Create(ADiagram: TDiagram);
begin
inherited Create;
FDiagram := ADiagram;
FValues := TDiagramScaleValueArtLines.Create(ADiagram);
FCursor := TDiagramScaleCursorArtLines.Create(ADiagram);
end;
destructor TDiagramScaleArtLines.Destroy;
begin
FValues.Free;
FCursor.Free;
inherited;
end;
{ ----------------------------------------------------------------------------
@ -2379,7 +2544,7 @@ end;
destructor TDiagramScaleBar.Destroy;
begin
FDiagram := nil;
//...
inherited;
end;
@ -2441,7 +2606,7 @@ end;
destructor TDiagramScaleGrid.Destroy;
begin
FDiagram := nil;
//...
inherited;
end;
@ -2501,7 +2666,6 @@ end;
destructor TDiagramScaleValues.Destroy;
begin
FDiagram := nil;
FFont.Free;
inherited;
end;
@ -2532,13 +2696,15 @@ constructor TDiagramScale.Create(ADiagram: TDiagram);
begin
inherited Create;
FDiagram := ADiagram;
FBar := TDiagramScaleBar.Create(ADiaGram);
FArtLines := TDiagramScaleArtLines.Create(ADiagram);
FBar := TDiagramScaleBar.Create(ADiagram);
FGrid := TDiagramScaleGrid.Create(ADiagram);
FValues := TDiagramScaleValues.Create(ADiagram);
end;
destructor TDiagramScale.Destroy;
begin
FArtLines.Free;
FBar.Free;
FGrid.Free;
FValues.Free;
@ -2562,7 +2728,6 @@ end;
destructor TDiagramCaption.Destroy;
begin
FDiagram := nil;
FFont.Free;
inherited;
end;
@ -2591,6 +2756,50 @@ begin
FDiagram.Repaint;
end;
{ ----------------------------------------------------------------------------
TDiagramAutoColors
---------------------------------------------------------------------------- }
constructor TDiagramAutoColors.Create(ADiagram: TDiagram);
begin
inherited Create;
FDiagram := ADiagram;
FEnabled := False;
FPositive := clBlue;
FZero := clWhite;
FNegative := clRed;
end;
destructor TDiagramAutoColors.Destroy;
begin
//...
inherited;
end;
procedure TDiagramAutoColors.SetEnabled(Value: Boolean);
begin
FEnabled := Value;
FDiagram.Repaint;
end;
procedure TDiagramAutoColors.SetPositive(Value: TColor);
begin
FPositive := Value;
FDiagram.Repaint;
end;
procedure TDiagramAutoColors.SetZero(Value: TColor);
begin
FZero := Value;
FDiagram.Repaint;
end;
procedure TDiagramAutoColors.SetNegative(Value: TColor);
begin
FNegative := Value;
FDiagram.Repaint;
end;
{ ----------------------------------------------------------------------------
TDiagram
---------------------------------------------------------------------------- }
@ -2606,7 +2815,7 @@ begin
Height := 50;
FPadding := TDiagramPadding.Create(Self);
FScale := TDiagramScale.Create(Self);
FAutoColor := False;
FAutoColors := TDiagramAutoColors.Create(Self);
//OnChange-Ereignisse
FCaption.Font.OnChange := PropertyChange;
FScale.Values.Font.OnChange := PropertyChange;
@ -2619,6 +2828,7 @@ begin
FValues.Free;
FPadding.Free;
FScale.Free;
FAutoColors.Free;
inherited;
end;
@ -2652,12 +2862,6 @@ begin
Repaint;
end;
procedure TDiagram.SetAutoColor(Value: Boolean);
begin
FAutoColor := Value;
Repaint;
end;
procedure TDiagram.PropertyChange(Sender: TObject);
begin
Repaint;
@ -2686,40 +2890,56 @@ begin
begin
DrawBar;
end;
if Scale.ArtLines.Values.Visible then
begin
DrawValueArtLines;
end;
case Layout of
dloColumns: for Index := 0 to Values.Count - 1 do
begin
DrawColumn(Index);
if (Values.Items[Index] as TDiagramValue).Visible then
begin
DrawColumn(Index);
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
end;
dloPoints: for Index := 0 to Values.Count - 1 do
begin
if (Values.Items[Index] as TDiagramValue).Visible then
begin
DrawPoint(Index);
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
end;
dloLines: for Index := 0 to Values.Count - 1 do
begin
if (Values.Items[Index] as TDiagramValue).Visible then
begin
DrawLine(Index);
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
dloPoints: for Index := 0 to Values.Count - 1 do
begin
DrawPoint(Index);
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
dloLines: for Index := 0 to Values.Count - 1 do
begin
DrawLine(Index);
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
dloCustom: for Index := 0 to Values.Count - 1 do
begin
if Assigned(OnCustomDrawValue) then
if (Values.Items[Index] as TDiagramValue).Visible then
begin
OnCustomDrawValue(Self,Index,ValueRect(Index));
end;
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
if Assigned(OnCustomDrawValue) then
begin
OnCustomDrawValue(Self,Index,ValueRect(Index));
end;
if Assigned(OnDrawValue) then
begin
OnDrawValue(Self,Index);
end;
end;
end;
end;
@ -2730,6 +2950,10 @@ begin
DrawValue(Index);
end;
end;
if Scale.ArtLines.Cursor.Visible then
begin
DrawCursorArtLines;
end;
end;
procedure TDiagram.DrawBackground;
@ -2878,6 +3102,70 @@ begin
end;
end;
procedure TDiagram.DrawValueArtLines;
var
Index: Integer;
begin
with Canvas do
begin
if Scale.ArtLines.Values.Dotted then
begin
Canvas.Pen.Style := psDot;
end else
begin
Canvas.Pen.Style := psSolid;
end;
Canvas.Pen.Color := Scale.ArtLines.Values.Color;
Canvas.Pen.Width := Scale.ArtLines.Values.Width;
for Index := 0 to Values.Count - 1 do
begin
if (Values.Items[Index] as TDiagramValue).Value <> 0 then
begin
if (Values.Items[Index] as TDiagramValue).Value > 0 then
begin
MoveTo(ZeroWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value));
LineTo(ValueLeft(Index) + ValueWidth div 2,ValueHeight((Values.Items[Index] as TDiagramValue).Value));
end else
begin
MoveTo(ZeroWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value) - 1);
LineTo(ValueLeft(Index) + ValueWidth div 2,ValueHeight((Values.Items[Index] as TDiagramValue).Value) - 1);
end;
LineTo(ValueLeft(Index) + ValueWidth div 2,ZeroHeight);
end;
end;
end;
end;
procedure TDiagram.DrawCursorArtLines;
var
Index: Integer;
CursorPos: TPoint;
begin
if not (csDesigning in ComponentState) then
begin
with Canvas do
begin
if Scale.ArtLines.Cursor.Dotted then
begin
Canvas.Pen.Style := psDot;
end else
begin
Canvas.Pen.Style := psSolid;
end;
Canvas.Pen.Color := Scale.ArtLines.Cursor.Color;
Canvas.Pen.Width := Scale.ArtLines.Cursor.Width;
GetCursorPos(CursorPos);
CursorPos := ScreenToClient(CursorPos);
if (CursorPos.Y <> ZeroHeight) and (CursorPos.X >= 0) and (CursorPos.X < Width) and (CursorPos.Y >= 0) and (CursorPos.Y < Height) then
begin
MoveTo(ZeroWidth,CursorPos.Y);
LineTo(CursorPos.X,CursorPos.Y);
LineTo(CursorPos.X,ZeroHeight);
end;
end;
end;
end;
procedure TDiagram.DrawValue(Index: Integer);
begin
with Canvas do
@ -2893,14 +3181,20 @@ begin
Pen.Width := (Values.Items[Index] as TDiagramValue).BorderWidth;
Pen.Color := (Values.Items[Index] as TDiagramValue).BorderColor;
Pen.Style := psSolid;
Brush.Color := (Values.Items[Index] as TDiagramValue).Color;
if (Values.Items[Index] as TDiagramValue).Value > 0 then
if AutoColors.Enabled then
begin
Rectangle(ValueLeft(Index),ZeroHeight,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value));
if (Values.Items[Index] as TDiagramValue).Value > 0 then
begin
Brush.Color := AutoColors.Positive;
end else
begin
Brush.Color := AutoColors.Negative;
end;
end else
begin
Rectangle(ValueLeft(Index),ZeroHeight,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value) - 1);
Brush.Color := (Values.Items[Index] as TDiagramValue).Color;
end;
Rectangle(ValueLeft(Index),ZeroHeight,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value));
end;
end;
@ -2911,14 +3205,26 @@ begin
Pen.Width := (Values.Items[Index] as TDiagramValue).BorderWidth;
Pen.Color := (Values.Items[Index] as TDiagramValue).BorderColor;
Pen.Style := psSolid;
Brush.Color := (Values.Items[Index] as TDiagramValue).Color;
if (Values.Items[Index] as TDiagramValue).Value > 0 then
if AutoColors.Enabled then
begin
Ellipse(ValueLeft(Index),ValueHeight((Values.Items[Index] as TDiagramValue).Value) - ValueSpace div 2,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value) + ValueSpace div 2);
if (Values.Items[Index] as TDiagramValue).Value = 0 then
begin
Brush.Color := AutoColors.Zero;
end else
begin
if (Values.Items[Index] as TDiagramValue).Value > 0 then
begin
Brush.Color := AutoColors.Positive;
end else
begin
Brush.Color := AutoColors.Negative;
end;
end;
end else
begin
Ellipse(ValueLeft(Index),ValueHeight((Values.Items[Index] as TDiagramValue).Value) - ValueSpace div 2,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value) + ValueSpace div 2 - 1);
Brush.Color := (Values.Items[Index] as TDiagramValue).Color;
end;
Ellipse(ValueLeft(Index),ValueHeight((Values.Items[Index] as TDiagramValue).Value) - ValueSpace div 2,ValueLeft(Index) + ValueWidth,ValueHeight((Values.Items[Index] as TDiagramValue).Value) + ValueSpace div 2);
end;
end;
@ -3031,8 +3337,17 @@ begin
end;
function TDiagram.ValueLeft(Index: Integer): Integer;
var
ValueIndex: Integer;
begin
Result := ZeroWidth + (Index + 1) * Padding.Left + Index * Padding.Right + Index * ValueWidth;
Result := ZeroWidth + Padding.Left;
for ValueIndex := 1 to Index do
begin
if (Values.Items[ValueIndex] as TDiagramValue).Visible then
begin
Inc(Result,ValueSpace);
end;
end;
end;
function TDiagram.ValueWidth: Integer;
@ -3042,7 +3357,40 @@ end;
function TDiagram.ValueSpace: Integer;
begin
Result := (Width - ZeroWidth) div Values.Count;
if Values.Count = 0 then
begin
Result := 0;
end else
begin
Result := (Width - ZeroWidth) div Values.VisibleCount;
end;
end;
procedure TDiagram.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
inherited;
if Scale.FArtLines.Cursor.Visible then
begin
Repaint;
end;
end;
procedure TDiagram.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Scale.FArtLines.Cursor.Visible then
begin
Repaint;
end;
end;
procedure TDiagram.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Scale.FArtLines.Cursor.Visible then
begin
Repaint;
end;
end;
function TDiagram.ValueRect(Index: Integer): TRect;
@ -3052,7 +3400,13 @@ end;
function TDiagram.ValueRect(Value: TDiagramValue): TRect;
begin
Result := Rect(ValueLeft(Value.Index),Padding.Top,ValueLeft(Value.Index) + ValueWidth,Height - Padding.Bottom);
if Value.Visible then
begin
Result := Rect(ValueLeft(Value.Index),Padding.Top,ValueLeft(Value.Index) + ValueWidth,Height - Padding.Bottom);
end else
begin
Result := Rect(ValueLeft(Value.Index),Padding.Top,ValueLeft(Value.Index),Height - Padding.Bottom);
end;
end;
end.