Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#11

Re: Mehrere Icons nebeneinander darstellen

  Alt 11. Jul 2009, 22:26
Man könnte ja auch so:

Delphi-Quellcode:
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

type
  TIconBar = class(TGraphicControl)
  private
    FIconSize: integer;
    FIconSpace: integer;
    FClickedIndex: integer;
    FIconArray: Array of HIcon;
    procedure Sort;
    procedure SetIconSpacer(Value: integer);
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure AddIcon(Icon: HIcon);
    procedure DeleteIcon(Index: integer);
    property IconSize: integer read FIconSize;
    property ClickedIndex: integer read FClickedIndex;
    property IconSpacer: integer read FIconSpace write SetIconSpacer;
  end;

var
  Form1: TForm1;
  IconBar: TIconBar;

implementation

{$R *.dfm}

constructor TIconBar.Create;
begin
  inherited Create(Owner);

  FIconSize := 32;
  FIconSpace := 5;

  Width := FIconSize;
  Height := FIconSize;
end;

destructor TIconBar.Destroy;
var i: integer;
begin
  for i := 0 to length(FIconArray)-1 do
    DeleteObject(FIconArray[i]);
  SetLength(FIconArray, 0);

  inherited Destroy;
end;

procedure TIconBar.Sort;
var i,j,help, entrys: cardinal;
begin
  Entrys := length(FIconArray)-1;
  if Entrys > 0 then
  begin
    for i := 0 to Entrys - 1 do
      for j := i + 1 to Entrys do
        if FIconArray[i] < FIconArray[j] then
        begin
          help := FIconArray[i];
          FIconArray[i] := FIconArray[j];
          FIconArray[j] := help;
        end;
  end;
end;

procedure TIconBar.SetIconSpacer(Value: integer);
begin
  FIconSpace := Value;
end;

procedure TIconBar.Paint;
var i: integer;
begin
  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.FillRect(ClientRect);

  for i := 0 to length(FIconArray)-1 do
    DrawIconEx(Canvas.Handle, i * (FIconSize + FIconSpace), 0, FIconArray[i], FIconSize, FIconSize, 0, 0, DI_NORMAL);
end;

procedure TIconBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TIconBar.AddIcon;
begin
  Width := length(FIconArray) * (FIconSize + FIconSpace) + FIconSize;
  SetLength(FIconArray, length(FIconArray) + 1);
  FIconArray[length(FIconArray)-1] := Icon;
  Invalidate;
end;

procedure TIconBar.DeleteIcon;
begin
  // todo:

  if (index >= 0) and (index < length(FIconArray)) then
  begin
    DeleteObject(FIconArray[index]);
    FIconArray[index] := 0;

    // (Re) Sort ... die Lücke muss nach oben
    Sort;

    // Löschen des Null-Eintrags
    SetLength(FIconArray, length(FIconArray));

    Width := length(FIconArray) * (FIconSize + FIconSpace) - FIconSpace;
    Invalidate;
  end;
end;

// -------------------------------------------------------------------------//

procedure TForm1.FormCreate(Sender: TObject);
begin
  IconBar := TIconBar.Create(Self);
  IconBar.Top := 40;
  IconBar.Left := 40;
  IconBar.Parent := Self;
  IconBar.AddIcon( LoadIcon(0, IDI_APPLICATION) );
  IconBar.AddIcon( LoadIcon(0, IDI_ASTERISK) );
  IconBar.AddIcon( LoadIcon(0, IDI_EXCLAMATION) );
  IconBar.AddIcon( LoadIcon(0, IDI_HAND) );
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  IconBar.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  IconBar.DeleteIcon(1);
end;
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat