Einzelnen Beitrag anzeigen

Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#4

AW: MouseEnter/Leave bei Pie

  Alt 8. Apr 2013, 16:27
Ein Vorschlag zur Umsetzung

Delphi-Quellcode:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type

  TPie = Record
    StartAngle, EndAngle: Double;
    Color, HighLightColor: TColor;
  End;

  TPieArray = Array of TPie;

  TForm2 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseLeave(Sender: TObject);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  private
    FPieArray: TPieArray;
    FMA: Double;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

uses Math;
{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
  SetLength(FPieArray, 4);
  FPieArray[0].StartAngle := 0;
  FPieArray[0].EndAngle := 90;
  FPieArray[0].Color := clBlue;
  FPieArray[0].HighLightColor := clNavy;

  FPieArray[1].StartAngle := 90;
  FPieArray[1].EndAngle := 180;
  FPieArray[1].Color := clRed;
  FPieArray[1].HighLightColor := clMaroon;

  FPieArray[2].StartAngle := 180;
  FPieArray[2].EndAngle := 270;
  FPieArray[2].Color := clLime;
  FPieArray[2].HighLightColor := clGreen;

  FPieArray[3].StartAngle := 270;
  FPieArray[3].EndAngle := 360;
  FPieArray[3].Color := clSilver;
  FPieArray[3].HighLightColor := clGray;

end;

procedure TForm2.PaintBox1MouseLeave(Sender: TObject);
begin
  FMA := -1;
end;

procedure TForm2.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  cx, cy: Integer;
begin
  cx := PaintBox1.Width div 2;
  cy := PaintBox1.Height div 2;
  if SQRT( POWER(Y - cy,2) + POWER(Y - cy,2)) < cy then
     FMA := Round((360 - RadToDeg(ArcTan2(Y - cy, X - cx)))) mod 360
  else FMA := -1;
  PaintBox1.invalidate;
end;

procedure TForm2.PaintBox1Paint(Sender: TObject);
var
  i: Integer;
  DC: HDC;
  X, Y: Integer;

begin
  X := PaintBox1.Width div 2;
  Y := PaintBox1.Height div 2;
  for i := 0 to High(FPieArray) do
  begin
    if (FMA > FPieArray[i].StartAngle) and (FMA < FPieArray[i].EndAngle) then
      PaintBox1.Canvas.Brush.Color := FPieArray[i].HighLightColor
    else
      PaintBox1.Canvas.Brush.Color := FPieArray[i].Color;
    DC := PaintBox1.Canvas.Handle;
    BeginPath(DC);
    MoveToEx(DC, X, Y, nil);
    AngleArc(DC, X, Y, X, FPieArray[i].StartAngle, FPieArray[i].EndAngle - FPieArray[i].StartAngle);
    LineTo(DC, X, Y);
    EndPath(DC);
    StrokeAndFillPath(DC);
  end;

end;

end.
Miniaturansicht angehängter Grafiken
pie.png  
Angehängte Dateien
Dateityp: zip Pie.zip (82,9 KB, 2x aufgerufen)
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat