|
Antwort |
Registriert seit: 15. Dez 2005 Ort: NRW 229 Beiträge Delphi 12 Athens |
#1
Hallo Leute,
Firemonkey ist für mich neu und auf Delphi 10 bin ich auch erst vor 3 Jahren von Delphi 7 umgestiegen. Und in der Zeit habe ich nur mein altes Projekt angepasst bzw. gepflegt. Also nichts Neues gemacht. Ich hatte hier vor, eine Komponente zu machen, die bei Listboxen (oder ähnliches) oben drüber steht und als Menü/Buttonleiste arbeiten soll. Einige Sourcen für die Entwicklung habe ich hier aus anderen Themen kopiert (OwnedCollection). Ganz so schnell wie ich gedacht hatte, bekomme ich das jetzt aber nicht hin und meine Zeit läuft schon wieder davon. Daher stelle ich das hier einfach mal rein. Vielleicht möchte ja jemand das Gerüst benutzen und zu Ende programmieren, bzw. so viel Hilfe leisten, dass ich es selber schaffe. Die Komponente basiert auf einem TFlowLayout und hat als Inhalt eine Collection von TRectangles mit einem TImage und einem TLabel. Visuell kann ich die Collection aufbauen und auch verschiedene Einstellungen machen. Wer den Code liest, sollte recht schnell die Einstellungen und Möglichkeiten verstehen. Aktuell bekomme ich zur Entwicklung und zur Laufzeit immer einige (tote) Rechtecke zuviel, obwohl das TRectangle.Create in der richtigen Anzahl aufgerufen wird. Die Events fehlen größtenteils noch und die Größenanpassung habe ich aus meinem ersten Testprogramm (ohne Komponente) als Kommentar am Ende eingefügt. Also, wenn jemand Interesse/Lust hat sich damit zu beschäftigen wäre super. Bei mir fehlt gerade echt die Zeit. Der Sourcecode folgt hier drunter. Viele Grüße Thomas
Thomas
(Wir suchen eine(n) Entwickler(in) mit Ambitionen später ggf. die Softwarefirma zu leiten) Aktuell nicht mehr. Aber ab vielleicht 2024/2025 wird das wieder sehr interessant! |
Zitat |
Registriert seit: 15. Dez 2005 Ort: NRW 229 Beiträge Delphi 12 Athens |
#2
Delphi-Quellcode:
unit sng.ListboxMenu;
interface uses System.Classes, System.Types, System.UITypes, System.Imagelist, System.Generics.Collections, //System.Contnrs, System.WideStrings, System.SysUtils, FMX.Types, FMX.Graphics, FMX.StdCtrls, FMX.Objects, FMX.Layouts, FMX.ImgList, FMX.Utils, FMX.ActnList; type TsngListMenuItem = class; TsngListMenuItemCollection = class( TOwnedCollection) private FParentItem : TsngListMenuItem; function GetItem(Index: Integer): TsngListMenuItem; procedure SetItem(Index: Integer; Value: TsngListMenuItem); protected procedure SetItemName(AItem: TCollectionItem); override; public constructor Create(AOwner: TPersistent); virtual; procedure GetItemNames(List: Tstrings); overload; procedure GetItemNames(List: TWideStrings); overload; property Items[Index: Integer] : TsngListMenuItem read GetItem write SetItem; default; property ParentItem : TsngListMenuItem read FParentItem; end; TsngListMenuItem = class( TCollectionItem) private FmiRectangle : TRectangle; FmiImage : TImage; FmiLabel : TLabel; FColor : TAlphaColor; FColorHot : TAlphaColor; FImageIndex : Integer; FName : String; procedure Clear; procedure SetColor(const Value: TAlphaColor); procedure SetColorHot(const Value: TAlphaColor); procedure SetImageIndex(const Value: Integer); protected function GetDisplayName: string; override; procedure SetDisplayName(const Value: string); reintroduce; procedure miRectangleClick(Sender: TObject); procedure miRectangleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure miRectangleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure miRectangleMouseEnter(Sender: TObject); procedure miRectangleMouseLeave(Sender: TObject); public constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; // procedure DrawItem; published property Color : TAlphaColor read FColor write SetColor; property ColorHot : TAlphaColor read FColorHot write SetColorHot; property Imageindex : Integer read FImageIndex write SetImageIndex; property Name : String read FName write SetDisplayName; end; TLBMenuitemSettings = class(TPersistent) private FHeight : Integer; FWidth : Integer; FMargins : TBounds; FImageHeight : Integer; FImageWidth : Integer; FImageMargins : TBounds; FTextSettings : TTextSettings; FTextMargins : TBounds; procedure SetHeight(const Value: Integer); procedure SetWidth(const Value: Integer); function GetMargins: TBounds; procedure SetMargins(const Value: TBounds); procedure SetImageHeight(const Value: Integer); procedure SetImageWidth(const Value: Integer); function GetImageMargins: TBounds; procedure SetImageMargins(const Value: TBounds); function GetTextSettings: TTextSettings; procedure SetTextSettings(const Value: TTextSettings); function GetTextMargins: TBounds; procedure SetTextMargins(const Value: TBounds); public constructor Create(AOwner: TComponent); virtual; destructor Destroy; procedure Assign(Source: TPersistent); override; published property Height : Integer read FHeight write SetHeight; property Width : Integer read FWidth write SetWidth; property Margins : TBounds read GetMargins write SetMargins; property ImageHeight : Integer read FImageHeight write SetImageHeight; property ImageWidth : Integer read FImageWidth write SetImageWidth; property ImageMargins : TBounds read GetImageMargins write SetImageMargins; property TextSettings : TTextSettings read GetTextSettings write SetTextSettings; property TextMargins : TBounds read GetTextMargins write SetTextMargins; end; TsngListMenu = class( TFlowLayout, IGlyph) private [Weak] FImages : TCustomImageList; FImageLink : TGlyphImageLink; FActiveMenuItem : TsngListMenuItem; FMenu : TsngListMenuItemCollection; FMenuitemSettings : TLBMenuitemSettings; function GetMenuitemSettings: TLBMenuitemSettings; procedure SetMenuitemSettings(const Value: TLBMenuitemSettings); private { IGlyph } function GetImageIndex: TImageIndex; procedure SetImageIndex(const Value: TImageIndex); function GetImageList: TBaseImageList; inline; procedure SetImageList(const Value: TBaseImageList); function IGlyph.GetImages = GetImageList; procedure IGlyph.SetImages = SetImageList; procedure SetImages(const Value: TCustomImageList); function GetImages: TCustomImageList; protected procedure ImagesChanged; virtual; // procedure Paint; override; procedure SetMenu(Value: TsngListMenuItemCollection); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AssignTo(Dest: TPersistent); property ActiveMenuItem : TsngListMenuItem read FActiveMenuItem write FActiveMenuItem; published property Align; property Anchors; property ClipChildren; property ClipParent; property Cursor; property DragMode; property EnableDragHighlight; property Enabled; property Locked; property Height; property HitTest; property Images : TCustomImageList read GetImages write SetImages; property Margins; property Menu: TsngListMenuItemCollection read FMenu write SetMenu; property MenuitemSettings : TLBMenuitemSettings read GetMenuitemSettings write SetMenuitemSettings; property Opacity; property Padding; property PopupMenu; property Position; property RotationAngle; property RotationCenter; property Scale; property Size; property TouchTargetExpansion; property Visible; property Width; property TabOrder; property TabStop; property Justify; property JustifyLastLine; property FlowDirection; property HorizontalGap; property VerticalGap; {Drag and Drop events} property OnDragEnter; property OnDragLeave; property OnDragOver; property OnDragDrop; property OnDragEnd; {Mouse events} property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseEnter; property OnMouseLeave; property OnPainting; property OnPaint; property OnResize; property OnResized; end; procedure Register; implementation { TsngListMenuItemCollection } constructor TsngListMenuItemCollection.Create(AOwner: TPersistent); begin FParentItem := nil; if AOwner is TsngListMenuItem then FParentItem := TsngListMenuItem(AOwner); inherited Create(AOwner, TsngListMenuItem); end; function TsngListMenuItemCollection.GetItem(Index: Integer): TsngListMenuItem; begin Result := TsngListMenuItem(inherited Items[Index]); end; procedure TsngListMenuItemCollection.GetItemNames(List: Tstrings); var wList: TWIdeStringList; begin wList := TWIdeStringList.Create; try GetItemNames(wList); List.Assign(wList); finally wList.Free; end; end; procedure TsngListMenuItemCollection.GetItemNames(List: TWideStrings); var I: Integer; begin List.BeginUpdate; try List.Clear; for I := 0 to Count - 1 do with TsngListMenuItem(Items[I]) do if Name <> '' then List.Add(Name); finally List.EndUpdate; end; end; procedure TsngListMenuItemCollection.SetItem(Index: Integer; Value: TsngListMenuItem); begin inherited Items[Index] := Value; end; procedure TsngListMenuItemCollection.SetItemName(AItem: TCollectionItem); begin inherited SetItemName(AItem); // if Value is TTestCollectionItem then // begin // if TTestCollectionItem(AItem).Name = '' then // TTestCollectionItem(AItem).Name := Copy(ClassName, 2, 5) + IntToStr(ID + 1); // end; end; { TsngListMenuItem } procedure TsngListMenuItem.Assign(Source: TPersistent); var I: Integer; S: TsngListMenuItem; begin if Source is TsngListMenuItem then begin if Collection <> nil then Collection.BeginUpdate; try S := TsngListMenuItem(Source); FmiRectangle := S.FmiRectangle; FmiImage := S.FmiImage; FmiLabel := S.FmiLabel; ImageIndex := S.FImageIndex; Name := S.Name; finally if Collection <> nil then Collection.EndUpdate; end; end else inherited; end; procedure TsngListMenuItem.Clear; begin end; constructor TsngListMenuItem.Create(Collection: TCollection); // !! Achtung, hier ist noch Testcode, Zufallsfarben usw. begin inherited Create(Collection); FmiRectangle := TRectangle.Create(TsngListMenu(TsngListMenuItemCollection(Collection).GetOwner)); FmiRectangle.Parent := TFMXObject(FmiRectangle.Owner); //FmiRectangle.Fill.Kind := TBrushKind.None; FmiRectangle.Fill.Kind := TBrushKind.Solid; FmiRectangle.Fill.Color := TAlphaColor($FF000000) or (TAlphaColor(256*256*random(256)+256*random(256)+random(256))); FmiRectangle.Margins.Left := 5; FmiRectangle.Margins.Top := 1; FmiRectangle.Margins.Right := 5; FmiRectangle.Margins.Bottom := 1; FmiRectangle.Position.X := 5; FmiRectangle.Position.Y := 1; FmiRectangle.Size.Width := 120; FmiRectangle.Size.Height := 25; FmiRectangle.Size.PlatformDefault := False; FmiRectangle.Stroke.Kind := TBrushKind.None; FmiRectangle.OnClick := miRectangleClick; FmiRectangle.OnMouseDown := miRectangleMouseDown; FmiRectangle.OnMouseUp := miRectangleMouseUp; FmiRectangle.OnMouseEnter := miRectangleMouseEnter; FmiRectangle.OnMouseLeave := miRectangleMouseLeave; FmiImage := TImage.Create(FmiRectangle); FmiImage.Parent := FmiRectangle; FmiImage.Align := TAlignLayout.Left; FmiImage.HitTest := False; FmiImage.Margins.Left := 3; FmiImage.Margins.Top := 3; FmiImage.Margins.Right := 3; FmiImage.Margins.Bottom := 3; FmiImage.Position.X := 3; FmiImage.Position.Y := 3; FmiImage.Size.Width := 19; FmiLabel := TLabel.Create(FmiRectangle); FmiLabel.Parent := FmiRectangle; FmiLabel.Align := TAlignLayout.Client; FmiLabel.HitTest := False; FmiLabel.Margins.Left := 8; FmiLabel.Text := IntToStr(random(1000)); end; destructor TsngListMenuItem.Destroy; begin FmiLAbel.Free; FmiImage.Free; FmiRectangle.Free; inherited Destroy; end; //procedure TsngListMenuItem.DrawItem; //begin // FmiRectangle.Visible := true; //// FmiImage : TImage; // // FmiLabel : TLabel; //end; function TsngListMenuItem.GetDisplayName: string; begin Result := FName; end; procedure TsngListMenuItem.miRectangleClick(Sender: TObject); begin // if Sender = activeComponent then begin // ShowMessage(TComponent(Sender).Name+': Mouse Up'); // end; TsngListMenu(TRectangle(Sender).Owner).ActiveMenuItem := nil; (Sender as TRectangle).Fill.Color := Color; TRectangle(Sender).Repaint; end; procedure TsngListMenuItem.miRectangleMouseLeave(Sender: TObject); begin (Sender as TRectangle).Fill.Kind := TBrushKind.None; TRectangle(Sender).Repaint; end; procedure TsngListMenuItem.miRectangleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin TsngListMenu(TRectangle(Sender).Owner).ActiveMenuItem := self; (Sender as TRectangle).Fill.Color := ColorHot; TRectangle(Sender).Repaint; end; procedure TsngListMenuItem.miRectangleMouseEnter(Sender: TObject); begin (Sender as TRectangle).Fill.Kind := TBrushKind.Solid; if TsngListMenu(TRectangle(Sender).Owner).ActiveMenuItem = TsngListMenu(TsngListMenuItemCollection(Collection).Owner).ActiveMenuItem then (Sender as TRectangle).Fill.Color := ColorHot else (Sender as TRectangle).Fill.Color := Color; TRectangle(Sender).Repaint; end; procedure TsngListMenuItem.miRectangleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin TsngListMenu(Collection.Owner).ActiveMenuItem := nil; TRectangle(Sender).Repaint; end; procedure TsngListMenuItem.SetColor(const Value: TAlphaColor); begin FColor := Value; end; procedure TsngListMenuItem.SetColorHot(const Value: TAlphaColor); begin FColorHot := Value; end; procedure TsngListMenuItem.SetDisplayName(const Value: string); begin FName := Value; FmiLabel.Text := Value; inherited SetDisplayName(Value); end; procedure TsngListMenuItem.SetImageIndex(const Value: Integer); begin FImageIndex := Value; end; { TLBMenuitemSettings } procedure TLBMenuitemSettings.Assign(Source: TPersistent); begin if (Source is TLBMenuitemSettings) then begin FHeight := (Source as TLBMenuitemSettings).Height; FWidth := (Source as TLBMenuitemSettings).Width; FMargins := (Source as TLBMenuitemSettings).Margins; FImageHeight := (Source as TLBMenuitemSettings).ImageHeight; FImageWidth := (Source as TLBMenuitemSettings).ImageWidth; FImageMargins := (Source as TLBMenuitemSettings).ImageMargins; FTextSettings := (Source as TLBMenuitemSettings).TextSettings; FTextMargins := (Source as TLBMenuitemSettings).TextMargins; end; end; constructor TLBMenuitemSettings.Create(AOwner: TComponent); var r : TRectF; begin inherited Create; FHeight := 25; FImageHeight := 19; FImageMargins := TBounds.Create( TRectF.Create(3,3,3,3)); FImageWidth := 19; FMargins := TBounds.Create( TRectF.Create(5,1,5,1)); FTextMargins := TBounds.Create( TRectF.Create(8,0,0,0)); FTextSettings := TTextSettings.Create(self); FWidth := 120; end; destructor TLBMenuitemSettings.Destroy; begin FTextSettings.Free; FTextMargins.Free; FMargins.Free; FImageMargins.Free; inherited Destroy; end; function TLBMenuitemSettings.GetImageMargins: TBounds; begin Result := FImageMargins; end; function TLBMenuitemSettings.GetMargins: TBounds; begin Result := FMargins; end; function TLBMenuitemSettings.GetTextMargins: TBounds; begin Result := FTextMargins; end; function TLBMenuitemSettings.GetTextSettings: TTextSettings; begin Result := FTextSettings; end; procedure TLBMenuitemSettings.SetHeight(const Value: Integer); begin FHeight := Value; end; procedure TLBMenuitemSettings.SetImageHeight(const Value: Integer); begin FImageHeight := Value; end; procedure TLBMenuitemSettings.SetImageMargins(const Value: TBounds); begin FImageMargins.Assign(Value); end; procedure TLBMenuitemSettings.SetImageWidth(const Value: Integer); begin FImageWidth := Value; end; procedure TLBMenuitemSettings.SetMargins(const Value: TBounds); begin FMargins.Assign(Value); end; procedure TLBMenuitemSettings.SetTextMargins(const Value: TBounds); begin FTextMargins.Assign(Value); end; procedure TLBMenuitemSettings.SetTextSettings(const Value: TTextSettings); begin FTextSettings := Value; end; procedure TLBMenuitemSettings.SetWidth(const Value: Integer); begin FWidth := Value; end; { TsngListMenu } procedure TsngListMenu.AssignTo(Dest: TPersistent); begin if Dest is TsngListMenu then begin TsngListMenu(Dest).FMenu.Assign(FMenu); end else inherited AssignTo(Dest); end; constructor TsngListMenu.Create(AOwner: TComponent); begin inherited; FMenuitemSettings := TLBMenuitemSettings.Create(self); FImageLink := TGlyphImageLink.Create(Self); FActiveMenuItem := nil; FMenu := TsngListMenuItemCollection.Create(Self); Align := TAlignLayout.Top; Justify := TFlowJustify.Left; JustifyLastLine := TFlowJustify.Left; FlowDirection := TFlowDirection.LeftToRight; end; destructor TsngListMenu.Destroy; begin FreeAndNil(FMenu); FMenuitemSettings.Free; FImageLink.DisposeOf; inherited; end; function TsngListMenu.GetImageIndex: TImageIndex; begin Result := -1 end; function TsngListMenu.GetImageList: TBaseImageList; begin Result := FImageLink.Images; end; function TsngListMenu.GetImages: TCustomImageList; begin Result := TCustomImageList(FImageLink.Images); end; function TsngListMenu.GetMenuitemSettings: TLBMenuitemSettings; begin Result := FMenuitemSettings; end; procedure TsngListMenu.ImagesChanged; var I: Integer; begin // for I := 0 to FsngMenu.Count - 1 do // FsngMenu.Items[I].Changed; end; //procedure TsngListMenu.Paint; //var // i: Integer; // item: TsngListMenuItem; //begin // inherited; // for i := 0 to FMenu.Count-1 do // FMenu.Items[i].DrawItem; //end; procedure TsngListMenu.SetImageIndex(const Value: TImageIndex); begin // none end; procedure TsngListMenu.SetImageList(const Value: TBaseImageList); begin ValidateInheritance(Value, TCustomImageList, True); FImageLink.Images := Value; end; procedure TsngListMenu.SetImages(const Value: TCustomImageList); begin FImageLink.Images := Value; end; procedure TsngListMenu.SetMenu(Value: TsngListMenuItemCollection); begin FMenu.Assign(Value); end; procedure TsngListMenu.SetMenuitemSettings(const Value: TLBMenuitemSettings); begin FMenuitemSettings.Assign( Value); end; procedure Register; begin RegisterComponents('Eigene', [TsngListMenu]); end; (* procedure TffServices.FlowLayoutHeaderResize(Sender: TObject); var NewHeight : Single; begin NewHeight := 25 * trunc(AnzServiceButton / trunc(FlowLayoutHeader.Size.Width / (ServiceButtonWidth+10)) + 0.999999); if NewHeight <> FlowLayoutHeader.Size.Height then FlowLayoutHeader.Size.Height := NewHeight; end; *) end.
Thomas
(Wir suchen eine(n) Entwickler(in) mit Ambitionen später ggf. die Softwarefirma zu leiten) Aktuell nicht mehr. Aber ab vielleicht 2024/2025 wird das wieder sehr interessant! |
Zitat |
Themen-Optionen | Thema durchsuchen |
Ansicht | |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
LinkBack |
LinkBack URL |
About LinkBacks |