Einzelnen Beitrag anzeigen

bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.123 Beiträge
 
Delphi 11 Alexandria
 
#1

Bilder einer Toolbar in einer Listbox anzeigen

  Alt 17. Apr 2017, 12:55
ich möchte die Toolbuttons auf einer Toolbar in einer Listbox anzeigen und dann in ihrer Reihenfolge durchtauschen. Zusätzlich soll das Bild des Toolbuttons in der Listbox angezeigt werden.



Delphi-Quellcode:
 TListBoxItem = class
   BitMap : TBitmap ;
   Name : string ;
   index : Integer ;
   Left : Integer ;
 end;

TToolBarEditForm = class(TForm)
    lst_ToolBarButtons: TListBox;
    btn_scanButtons: TBitBtn;
    btn_Plus: TBitBtn;
    btn_minus: TBitBtn;
    btn_close: TBitBtn;
    procedure btn_scanButtonsClick(Sender: TObject);
    procedure btn_PlusClick(Sender: TObject);
    procedure btn_minusClick(Sender: TObject);
  private
    { Private declarations }

    FToolbar : TToolbar ;
    procedure lst_ToolBarButtonsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lst_ToolBarButtonsMeasureItem(Control: TWinControl;
      Index: Integer; var Height: Integer);
  public
    { Public declarations }
  property ConfigToolbar : TToolbar read FToolbar write FToolbar;
  end;

var
  ToolBarEditForm: TToolBarEditForm;

implementation


{$R *.dfm}


procedure SetButtonIndex(var Toolbar: TToolbar; Button: INteger;
  Value: INteger);
var
  Positions: array of INteger;
  ButtonID: INteger;
  i, CurrentID: INteger;
begin
  CurrentID := Toolbar.Buttons[Button].Index;
  SetLength(Positions, Toolbar.ButtonCount);
  for ButtonID := 0 to Toolbar.ButtonCount - 1 do
  begin
    Positions[ButtonID] := Toolbar.Buttons[ButtonID].Left;
  end;

  if (CurrentID <> Value) and (CurrentID > -1) and (Value > -1) and
    (Value < Length(Positions)) then
  begin
    i := Toolbar.Buttons[Button].Left;
    Toolbar.Buttons[Button].Left := Toolbar.Buttons[Value].Left;
    Toolbar.Buttons[Value].Left := i;
  end;
end;




procedure TToolBarEditForm.btn_minusClick(Sender: TObject);
var
  i: INteger;
begin
  i := lst_ToolBarButtons.ItemIndex;
  SetButtonIndex(FToolbar, i, i - 1);

  lst_ToolBarButtons.Items.Clear;
  btn_scanButtonsClick(Sender);
end;

procedure TToolBarEditForm.btn_PlusClick(Sender: TObject);
var
  i: INteger;
begin
  i := lst_ToolBarButtons.ItemIndex;
  SetButtonIndex(FToolbar, i, i + 1);

  lst_ToolBarButtons.Items.Clear;
  btn_scanButtonsClick(Sender);
end;

procedure TToolBarEditForm.btn_scanButtonsClick(Sender: TObject);
var
  i: INteger;
  aListBoxItem : TListBoxItem ;
begin

  lst_ToolBarButtons.Style := lbOwnerDrawVariable;
  lst_ToolBarButtons.OnDrawItem := lst_ToolBarButtonsDrawItem ;


  for i := 0 to FToolbar.ButtonCount - 1 do
  begin
    aListBoxItem :=TListBoxItem.Create;

    aListBoxItem.Name := FToolbar.Buttons[i].Name ;
    aListBoxItem.index := FToolbar.Buttons[i].Index;
    FToolbar.Images.GetBitmap(i, aListBoxItem.BitMap ) ;

    lst_ToolBarButtons.AddItem(aListBoxItem.Name,aListBoxItem );

  end;
end;


procedure CenterText(Cnv: TCanvas; Rect: TRect; S: string);
var
  X, Y: Integer;
begin
  X := (Rect.Right + Rect.Left - Cnv.TextWidth(S)) div 2;
  Y := (Rect.Bottom + Rect.Top - Cnv.TextHeight(S)) div 2;
  Cnv.TextOut(X, Y, S);
end;

procedure TToolBarEditForm.lst_ToolBarButtonsDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  aItem : TListBoxItem ;
begin
  with lst_ToolBarButtons do
  begin
    Canvas.FillRect(Rect);
    if Items.Objects[Index] <> nil then
    begin
       aItem := Items.Objects[Index] as TListBoxItem;
       Bitmap := aItem.BitMap as TBitmap;
      Canvas.BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2,
        Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
        Bitmap.Height), Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]);
    end;
    Rect.Left := Rect.Left + Bitmap.Width + 4;
    Rect.Bottom := Rect.Top + Bitmap.Height + 4;
    CenterText(Canvas, Rect, Items.Strings[Index]);
  end;
end;

procedure TToolBarEditForm.lst_ToolBarButtonsMeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
begin
  if Index = 0 then Height := 32 ;
end;

beim Aufruf der Funktion Canvas Brushcopy bekomme ich jedoch eine AV, sieht jemand meinen Fehler ?
  Mit Zitat antworten Zitat