Horizontales anklickbares Menü bauen

[Bummi]

Noch nicht in eine Komponente gegossen, aber vielleicht willst Du das ja tun ...

Delphi-Quellcode:

unit Test;
///20120828 by Thomas Wassermann
interface

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

type

  TReginfo=Record
      Caption:String;
      Color:TColor;
      SelColor:TColor;
      RGN:HRGN;
      Rec:TRect;
      Selected:Boolean;
  End;
  TReginfoArray=Array of TReginfo;

  TForm5 = class(TForm)
    PaintBox1: TPaintBox;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    { Private-Deklarationen }
    FReginfoArray:TReginfoArray;
    procedure Clicked(index: Integer);
  public
    { Public-Deklarationen }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}
Const
 C_SW=200;

procedure TForm5.FormCreate(Sender: TObject);

var
 c:TCanvas;
 i:Integer;
begin
   SetLength(FReginfoArray,3);
   FReginfoArray[0].Color := clGreen;
   FReginfoArray[0].SelColor := clLime;
   FReginfoArray[0].Caption := 'Lasche1';
   FReginfoArray[1].Color := clNavy;
   FReginfoArray[1].SelColor := clBlue;
   FReginfoArray[1].Caption := 'Lasche2';
   FReginfoArray[2].Color := clRed;
   FReginfoArray[2].SelColor := clYellow;
   FReginfoArray[2].Caption := 'Lasche3';
   c := paintbox1.Canvas;
   for I := Low(FReginfoArray) to High(FReginfoArray) do
      begin
         BeginPath(c.Handle);
         MoveToEx(c.Handle, i*C_SW, 0, nil);
         AngleArc(c.Handle,(i+1)*C_SW,  Paintbox1.Height div 2, Paintbox1.Height div 2,  90 ,-180);
         AngleArc(c.Handle,(i )*C_SW ,  Paintbox1.Height div 2, Paintbox1.Height div 2, -90 ,180);
         EndPath(c.Handle);
         FReginfoArray[i].RGN := PathToRegion(c.Handle);
         FReginfoArray[i].Rec := Rect(i*C_SW,0,(i+1)*C_SW,Paintbox1.Height);
      end;

end;

procedure TForm5.FormDestroy(Sender: TObject);
var
 i:Integer;
begin
  for I := Low(FReginfoArray) to High(FReginfoArray) do
    begin
         DeleteObject(FReginfoArray[i].RGN);
    end;
end;

procedure TForm5.Clicked(index:Integer);
begin
    Showmessage(FReginfoArray[index].Caption);
end;

procedure TForm5.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 i:Integer;
begin
    for I := Low(FReginfoArray) to High(FReginfoArray) do
      begin
        FReginfoArray[i].Selected := PtInRegion(FReginfoArray[i].RGN,x,y);
        PaintBox1.Invalidate;
        if PtInRegion(FReginfoArray[i].RGN,x,y)  then Clicked(i);

      end;
end;

procedure TForm5.PaintBox1Paint(Sender: TObject);
var
  c:TCanvas;
  I:Integer;
begin
   c := TpaintBox(Sender).Canvas;
   c.Font.Size := 14;
   for I := Low(FReginfoArray) to High(FReginfoArray) do
      begin
         C.Brush.Style := bsSolid;
         if FReginfoArray[i].Selected then c.Brush.Color :=  FReginfoArray[i].SelColor else  c.Brush.Color :=  FReginfoArray[i].Color;
         PaintRgn(c.Handle,FReginfoArray[i].RGN);
         AngleArc(c.Handle,(i+1)*C_SW,  Paintbox1.Height div 2, Paintbox1.Height div 2,  90 ,-180);
         AngleArc(c.Handle,(i )*C_SW ,  Paintbox1.Height div 2, Paintbox1.Height div 2, -90 ,180);
         C.Brush.Style := bsClear;
         c.TextRect(FReginfoArray[i].Rec,FReginfoArray[i].Caption,[tfCenter,tfVerticalCenter,tfSingleLine]);
      end;
end;

end.