Registriert seit: 8. Jun 2009
Ort: Bayern
1.137 Beiträge
Delphi 11 Alexandria
|
Bilder einer Toolbar in einer Listbox anzeigen
17. Apr 2017, 13: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 ?
|
|
Zitat
|