Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Bilder einer Toolbar in einer Listbox anzeigen (https://www.delphipraxis.net/192419-bilder-einer-toolbar-einer-listbox-anzeigen.html)

bernhard_LA 17. Apr 2017 12:55

Bilder einer Toolbar in einer Listbox anzeigen
 
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 ?


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:39 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz