[text] test

Viewer

*** This page was generated with the meta tag "noindex, nofollow". This happened because you selected this option before saving or the system detected it as spam. This means that this page will never get into the search engines and the search bot will not crawl it. There is nothing to worry about, you can still share it with anyone.

copy download embed printName: test

unit kallupPanelMenu;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus,
//
DesignIntf, DesignEditors, DesignMenus, DesignWindows;
type
TkallupMenuPanel = class;
// ----------------------------------------------------------
// component menu for the quick access to the control
// ----------------------------------------------------------
TkallupMenuEditor = class (TComponentEditor)
function GetVerbCount: Integer; override;
function GetVerb(Index: Integer): string; override;
procedure ExecuteVerb(Index: Integer); override;
procedure Edit; override;
end;
// ----------------------------------------------------------
// collection for items of the menu panels, one for each ...
// ----------------------------------------------------------
TkallupMenuPanelCollection = class(TCollection)
private
FComponent : TComponent;
FCollectionString: String;
public
constructor Create(AOwner: TComponent);
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
end;
// ----------------------------------------------------------
// item display state mode basis class
// ----------------------------------------------------------
TkallupMenuPanelCollectionItemStateBasis = class(TPersistent)
private
FBitmap : TBitmap;
FCaption : TCaption;
FColor : TColor;
FFontText : TFont;
FFontShortCut : TFont;
procedure SetBitmap (AValue: TBitmap);
procedure SetCaption (AValue: TCaption);
procedure SetColor (AValue: TColor);
procedure SetFontText (AValue: TFont);
procedure SetFontShortCut (AValue: TFont);
public
constructor Create;
destructor Destroy; override;
published
property Bitmap : TBitmap read FBitmap write SetBitmap;
property Caption : TCaption read FCaption write SetCaption;
property Color : TColor read FColor write SetColor;
property FontText : TFont read FFontText write SetFontText;
property FontShortCut : TFont read FFontShortCut write SetFontShortCut;
end;
// ----------------------------------------------------------
// item on hover display mode
// ----------------------------------------------------------
TkallupMenuPanelCollectionItemHover = class(TkallupMenuPanelCollectionItemStateBasis)
public
constructor Create;
destructor Destroy; override;
published
property Bitmap;
property Caption;
property Color;
property FontText;
property FontShortCut;
end;
// ----------------------------------------------------------
// item on normal display mode
// ----------------------------------------------------------
TkallupMenuPanelCollectionItemNormal = class(TkallupMenuPanelCollectionItemStateBasis)
public
constructor Create;
destructor Destroy; override;
published
property Bitmap;
property Caption;
property Color;
property FontText;
property FontShortCut;
end;
// ----------------------------------------------------------
// item on selected with mousePress
// ----------------------------------------------------------
TkallupMenuPanelCollectionItemSelected = class(TkallupMenuPanelCollectionItemStateBasis)
public
constructor Create;
destructor Destroy; override;
published
property Bitmap;
property Caption;
property Color;
property FontText;
property FontShortCut;
end;
// ----------------------------------------------------------
// a collection item for the collection
// ----------------------------------------------------------
TkallupMenuPanelCollectionItem = class(TCollectionItem)
private
{ state properties }
FItemHover : TkallupMenuPanelCollectionItemHover;
FItemNormal : TkallupMenuPanelCollectionItemNormal;
FItemSelected : TkallupMenuPanelCollectionItemSelected;
FItemShortCut : TComboBox;
FItemName : String;
FCollection : TkallupMenuPanelCollection;
FComponent : TComponent;
FPopupMenu : TPopupMenu;
procedure SetItemSubItem (AValue: TkallupMenuPanelCollection);
procedure SetItemHover (const AValue: TkallupMenuPanelCollectionItemHover );
procedure SetItemNormal (const AValue: TkallupMenuPanelCollectionItemNormal );
procedure SetItemSelected (const AValue: TkallupMenuPanelCollectionItemSelected);
procedure SetItemShortCut (const AValue: TComboBox);
procedure SetItemName (const AValue: String);
public
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
published
property Items : TkallupMenuPanelCollection read FCollection write SetItemSubItem;
property Hover : TkallupMenuPanelCollectionItemHover read FItemHover write SetItemHover;
property Normal : TkallupMenuPanelCollectionItemNormal read FItemNormal write SetItemNormal;
property Selected : TkallupMenuPanelCollectionItemSelected read FItemSelected write SetItemSelected;
property ShortCut : TComboBox read FItemShortCut write SetItemShortCut;
property Text : String read FItemName write SetItemName;
end;
// ----------------------------------------------------------
// wrapper class to save code size, for índividual menu ...
// ----------------------------------------------------------
TkallupMenuPanel = class(TComponent)
private
FCollection: TkallupMenuPanelCollection;
function GetCollectionString: String;
procedure SetItems(const AValue: TkallupMenuPanelCollection);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Items: TkallupMenuPanelCollection read FCollection write SetItems;
property CollectionString: String read GetCollectionString;
end;
TkallupMenuPanelDialog = class(TForm)
end;
procedure Register;
implementation
uses kallupPanelMenuDesigner;
{ TkallupMenuPanelCollectionItemStateBasis }
constructor TkallupMenuPanelCollectionItemStateBasis.Create;
begin
inherited Create;
end;
destructor TkallupMenuPanelCollectionItemStateBasis.Destroy;
begin
if self.FFontText <> nil then FreeAndNil(self.FFontText);
if self.FFontShortCut <> nil then FreeAndNil(self.FFontShortCut);
if self.FBitmap <> nil then FreeAndNil(self.FBitmap);
inherited;
end;
procedure TkallupMenuPanelCollectionItemStateBasis.SetBitmap(AValue: TBitmap);
begin
if FBitmap = nil then FBitmap := TBitmap.Create;
if AValue = nil then AValue := TBitmap.Create;
FBitmap.Assign(AValue);
end;
procedure TkallupMenuPanelCollectionItemStateBasis.SetCaption(AValue: TCaption);
begin
FCaption := AValue;
end;
procedure TkallupMenuPanelCollectionItemStateBasis.SetColor(AValue: TColor);
begin
FColor := AValue;
end;
procedure TkallupMenuPanelCollectionItemStateBasis.SetFontText(AValue: TFont);
begin
if FFontText = nil then FFontText := TFont.Create;
if AValue = nil then AValue := TFont.Create;
FFontText.Assign(AValue);
end;
procedure TkallupMenuPanelCollectionItemStateBasis.SetFontShortCut(AValue: TFont);
begin
if FFontShortCut = nil then FFontText := TFont.Create;
if AValue = nil then AValue := TFont.Create;
FFontShortCut.Assign(AValue);
end;
{ TkallupMenuPanelCollectionItemHover }
constructor TkallupMenuPanelCollectionItemHover.Create;
begin
inherited Create;
self.FFontText := TFont.Create;
self.FFontShortCut := TFont.Create;
self.FBitmap := TBitmap.Create;
end;
destructor TkallupMenuPanelCollectionItemHover.Destroy;
begin
if self.FFontText <> nil then FreeAndNil(self.FFontText);
if self.FFontShortCut <> nil then FreeAndNil(self.FFontShortCut);
if self.FBitmap <> nil then FreeAndNil(self.FBitmap);
inherited Destroy;
end;
{ TkallupMenuPanelCollectionItemNormal }
constructor TkallupMenuPanelCollectionItemNormal.Create;
begin
inherited Create;
self.FFontText := TFont.Create;
self.FFontShortCut := TFont.Create;
self.FBitmap := TBitmap.Create;
end;
destructor TkallupMenuPanelCollectionItemNormal.Destroy;
begin
if self.FFontText <> nil then FreeAndNil(self.FFontText);
if self.FFontShortCut <> nil then FreeAndNil(self.FFontShortCut);
if self.FBitmap <> nil then FreeAndNil(self.FBitmap);
inherited Destroy;
end;
{ TkallupMenuPanelCollectionItemSelected }
constructor TkallupMenuPanelCollectionItemSelected.Create;
begin
inherited Create;
self.FFontText := TFont.Create;
self.FFontShortCut := TFont.Create;
self.FBitmap := TBitmap.Create;
end;
destructor TkallupMenuPanelCollectionItemSelected.Destroy;
begin
if self.FFontText <> nil then FreeAndNil(self.FFontText);
if self.FFontShortCut <> nil then FreeAndNil(self.FFontShortCut);
if self.FBitmap <> nil then FreeAndNil(self.FBitmap);
inherited Destroy;
end;
{ TkallupMenuEditor }
function TkallupMenuEditor.GetVerbCount: Integer;
begin
result := 3;
end;
function TkallupMenuEditor.GetVerb (Index: Integer): string;
begin
case Index of
0: Result := ' Individual Menus © 2022 by paule32)';
1: Result := '&About ...';
2: Result := 'Open Design Editor';
end;
end;
procedure TKallupMenuEditor.ExecuteVerb (Index: Integer);
begin
case Index of
0: begin end;
1: begin
MessageDlg ('This is a simple component editor', mtInformation, [mbOK], 0);
end;
2: begin
Form1 := TForm1.Create(Application);
Form1.ShowModal;
end
end;
end;
procedure TKallupMenuEditor.Edit;
begin
Beep;
ExecuteVerb(0);
end;
{ TkallupMenuPanelCollectionItem }
constructor TkallupMenuPanelCollectionItem.Create(AOwner: TCollection);
begin
inherited Create(AOwner);
self.FItemHover := TkallupMenuPanelCollectionItemHover . Create;
self.FItemNormal := TkallupMenuPanelCollectionItemNormal . Create;
self.FItemSelected := TkallupMenuPanelCollectionItemSelected . Create;
self.FCollection := TkallupMenuPanelCollection.Create(self.FComponent);
end;
destructor TkallupMenuPanelCollectionItem.Destroy;
begin
FreeAndNil(self.FItemSelected);
FreeAndNil(self.FItemNormal );
FreeAndNil(self.FItemHover );
inherited Destroy;
end;
procedure TkallupMenuPanelCollectionItem.SetItemSubItem(AValue: TkallupMenuPanelCollection);
begin
FCollection.Assign(AValue);
end;
procedure TkallupMenuPanelCollectionItem.SetItemHover(const AValue: TkallupMenuPanelCollectionItemHover );
begin
FItemHover := AValue;
end;
procedure TkallupMenuPanelCollectionItem.SetItemNormal(const AValue: TkallupMenuPanelCollectionItemNormal );
begin
FItemNormal := AValue;
end;
procedure TkallupMenuPanelCollectionItem.SetItemSelected(const AValue: TkallupMenuPanelCollectionItemSelected);
begin
FItemSelected := AValue;
end;
procedure TkallupMenuPanelCollectionItem.SetItemName(const AValue: String);
begin
FItemName := AValue;
end;
procedure TkallupMenuPanelCollectionItem.SetItemShortCut(const AValue: TComboBox);
begin
FItemShortCut := AValue;
end;
{ TkallupMenuPanelCollection }
constructor TkallupMenuPanelCollection.Create(AOwner: TComponent);
var
item : TkallupMenuPanelCollectionItem;
begin
item := TkallupMenuPanelCollectionItem.Create(self);
item.FComponent := AOwner;
inherited Create(TCollectionItemClass(item));
FComponent := AOwner;
end;
function TkallupMenuPanelCollection.GetOwner: TPersistent;
begin
Result := FComponent;
end;
procedure TkallupMenuPanelCollection.Update(Item: TCollectionItem);
var
str: String;
i: Integer;
begin
str := '';
for i := 0 to Count- 1 do
begin
str := str + (Items[i] as TkallupMenuPanelCollectionItem).Text;
if i < Count - 1 then
str := str + '-';
end;
FCollectionString := str;
end;
{ TkallupMenuPanel }
constructor TkallupMenuPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCollection := TkallupMenuPanelCollection.Create(self);
end;
destructor TKallupMenuPanel.Destroy;
begin
FCollection.Free;
inherited;
end;
procedure TkallupMenuPanel.SetItems(const AValue: TkallupMenuPanelCollection);
begin
FCollection.Assign(AValue);
end;
function TkallupMenuPanel.GetCollectionString: String;
begin
Result := FCollection.FCollectionString;
end;
procedure Register;
begin
RegisterComponents('KALLUP', [TkallupMenuPanel]);
RegisterComponentEditor (TkallupMenuPanel, TKallupMenuEditor);
end;
end.

Editor

You can edit this paste and save as new:

fullscreen copy clear

Syntax Highlighting

Title / Paste Name

Meta robots tag

reCaptcha

File Description

test
Paste Code
25 Dec-2021
12.64 Kb

You can Share it:

Latest Code Pastes

Full list

Tools

[text] test

Viewer

Editor