İhtiyacım vardı, kolay da görünüyordu...
'Checked' ve 'RadioGroup' özellikleri şimdilik yok.
Bileşen yazma konusunda kaynak olabileceği için burada başlık açtım, umarım doğru yerde başlık açmışımdır
Edit:Renk ve font'u ayarlamak için UCMainMenuSettings adında bir bileşen daha var, onu kullanmanız gerekiyor. (Object Inspector kalabalık olmasın diye ayırdım)
(Nasıl yükleneceğini kodlardan sonra yazacağım)
Kod: Tümünü seç
unit UCMainMenu;
interface
uses
SysUtils, Classes, Menus, Windows, Graphics, Forms, Dialogs;
type
TUCMainMenuSettings = class(TComponent)
private
{ Private declarations }
FMainItemFont: TFont;
FMainItemHighlightFont: TFont;
FMainItemColor: TColor;
FMainItemHighlightColor: TColor;
FSubItemFont: TFont;
FSubItemHighlightFont: TFont;
FSubItemColor: TColor;
FSubItemHighlightColor: TColor;
FBarWidth: Integer;
FBarColor: TColor;
procedure SetMainItemFont(const Value: TFont);
procedure SetMainItemHighlightFont(const Value: TFont);
procedure SetSubItemFont(const Value: TFont);
procedure SetSubItemHighlightFont(const Value: TFont);
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor Create(AOwner: TComponent); override;
property MainItemFont: TFont read FMainItemFont write SetMainItemFont;
property MainItemHighlightFont: TFont read FMainItemHighlightFont write SetMainItemHighlightFont;
property MainItemColor: TColor read FMainItemColor write FMainItemColor;
property MainItemHighlightColor: TColor read FMainItemHighlightColor write FMainItemHighlightColor;
property SubItemFont: TFont read FSubItemFont write SetSubItemFont;
property SubItemHighlightFont: TFont read FSubItemHighlightFont write SetSubItemHighlightFont;
property SubItemColor: TColor read FSubItemColor write FSubItemColor;
property SubItemHighlightColor: TColor read FSubItemHighlightColor write FSubItemHighlightColor;
property BarWidth: Integer read FBarWidth write FBarWidth default 20;
property BarColor: TColor read FBarColor write FBarColor;
end;
type
TUCMainMenu = class(TMainMenu)
private
{ Private declarations }
FMainMenuSettings: TUCMainMenuSettings;
FMinItemWidth: Integer;
procedure DoLoaded;
procedure Loaded; override;
procedure DrawItemEvent(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure MeasureItemEvent(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure SetOwnerDraw(const Value: Boolean);
function IsMainItem(AItem: TMenuItem): Boolean;
function GetItemWidth(AItem: TMenuItem; ACanvas: TCanvas): Integer;
function GetOwnerDraw: Boolean;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor Create(AOwner: TComponent); override;
property OwnerDraw: Boolean read GetOwnerDraw write SetOwnerDraw;
property MainMenuSettings: TUCMainMenuSettings read FMainMenuSettings write FMainMenuSettings;
property MinItemWidth: Integer read FMinItemWidth write FMinItemWidth default 100;
end;
procedure Register;
const
_uRightSpace = 8;
_uVerticalSpace = 3;
_uArrowWidth = 7;
implementation
uses Math;
procedure Register;
begin
RegisterComponents('UluCoder', [TUCMainMenu]);
RegisterComponents('UluCoder', [TUCMainMenuSettings]);
end;
{ TUCMainMenuSettings }
constructor TUCMainMenuSettings.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBarWidth := 20;
FBarColor := clMenuBar;
FMainItemFont := TFont.Create;
FMainItemHighlightFont := TFont.Create;
FSubItemFont := TFont.Create;
FSubItemHighlightFont := TFont.Create;
if (AOwner is TCustomForm) then
begin
with (AOwner as TCustomForm) do
begin
FMainItemFont.Assign(Font);
FMainItemColor := Color;
FMainItemHighlightFont.Assign(Font);
FMainItemHighlightFont.Color := clHighlightText;
FMainItemHighlightColor := clHighlight;
FSubItemFont.Assign(Font);
FSubItemColor := Color;
FSubItemHighlightFont.Assign(Font);
FSubItemHighlightFont.Color := clHighlightText;
FSubItemHighlightColor := clHighlight;
end;//With
end//if
else begin
FMainItemColor := clMenu;
FMainItemHighlightFont.Color := clHighlightText;
FMainItemHighlightColor := clMenuHighlight;
FSubItemColor := clMenu;
FSubItemHighlightFont.Color := clHighlightText;
FSubItemHighlightColor := clMenuHighlight;
end;//else-if
end;
procedure TUCMainMenuSettings.SetMainItemFont(const Value: TFont);
begin
FMainItemFont.Assign(Value);
end;
procedure TUCMainMenuSettings.SetMainItemHighlightFont(const Value: TFont);
begin
FMainItemHighlightFont.Assign(Value);
end;
procedure TUCMainMenuSettings.SetSubItemFont(const Value: TFont);
begin
FSubItemFont.Assign(Value);
end;
procedure TUCMainMenuSettings.SetSubItemHighlightFont(const Value: TFont);
begin
FSubItemHighlightFont.Assign(Value);
end;
{ TUCMainMenu }
constructor TUCMainMenu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
inherited OwnerDraw := True;
FMinItemWidth := 100;
OwnerDraw := True;
end;
procedure TUCMainMenu.DoLoaded;
procedure SetItemEvents(AItem: TMenuItem;
ADrawItem: TMenuDrawItemEvent;
AMeasureItem: TMenuMeasureItemEvent);
var
i: Integer;
begin
AItem.OnDrawItem := ADrawItem;
AItem.OnMeasureItem := AMeasureItem;
for i := 0 to Pred(AItem.Count) do
SetItemEvents(AItem.Items[i], ADrawItem, AMeasureItem);
end;//SetItemEvents
var
i: Integer;
begin
if not(Assigned(FMainMenuSettings)) then
Exit;
for i := 0 to Pred(Items.Count) do
SetItemEvents(Items[i], DrawItemEvent, MeasureItemEvent);
end;//DoLoaded
procedure TUCMainMenu.DrawItemEvent(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure LoadCanvasProperties(AFont: TFont; AColor: TColor);
begin
ACanvas.Font.Assign(AFont);
ACanvas.Brush.Style := bsClear;
ACanvas.Brush.Color := AColor;
end;//LoadCanvasProperties
procedure DrawItemCaption(LeftSpace: Integer);
begin
ARect.Left := ARect.Left + LeftSpace;
DrawText(ACanvas.Handle, PChar(TMenuItem(Sender).Caption), -1,
ARect, (DT_SINGLELINE or DT_LEFT or DT_VCENTER));
ARect.Left := ARect.Left - LeftSpace;
end;//DrawItemCaption
procedure DrawItemImage(AImageIndex: Integer);
var
ABitmap: TBitmap;
ImageX,
ImageY: Integer;
begin
ABitmap := TBitmap.Create;
Images.GetBitmap(AImageIndex, ABitmap);
if ABitmap.Width > MainMenuSettings.BarWidth then
ABitmap.Width := MainMenuSettings.BarWidth;
if ABitmap.Height > (ARect.Right - ARect.Left) then
ABitmap.Width := (ARect.Right - ARect.Left);
ImageX := (ARect.Left + ((MainMenuSettings.BarWidth - ABitmap.Width) div 2));
ImageY := (ARect.Top + ((ARect.Bottom - ARect.Top - ABitmap.Height) div 2));
Images.Draw(ACanvas, ImageX, ImageY, AImageIndex);
end;//DrawItemImage
procedure DrawImageBar;
var
BarRect: TRect;
begin
BarRect := ARect;
BarRect.Right := MainMenuSettings.BarWidth;
ACanvas.Brush.Color := MainMenuSettings.BarColor;
ACanvas.FillRect(BarRect);
end;//DrawImageBar
begin
if IsMainItem(TMenuItem(Sender)) then
begin
with MainMenuSettings do
if Selected then
LoadCanvasProperties(MainItemHighlightFont, MainItemHighlightColor)
else
LoadCanvasProperties(MainItemFont, MainItemColor);
ACanvas.FillRect(ARect);
DrawItemCaption(_uRightSpace - 2);
end//if
else begin
with MainMenuSettings do
begin
if Selected then
begin
LoadCanvasProperties(SubItemHighlightFont, SubItemHighlightColor);
ACanvas.FillRect(ARect);
end//if
else begin
ACanvas.Brush.Color := SubItemColor;
ACanvas.FillRect(ARect);
DrawImageBar;
LoadCanvasProperties(SubItemFont, SubItemColor);
end;//else-if
DrawItemCaption(BarWidth + _uRightSpace);
if TMenuItem(Sender).ImageIndex >= 0 then
DrawItemImage(TMenuItem(Sender).ImageIndex);
end;//with
end;//else-if
end;//DrawMenuItem
function TUCMainMenu.GetItemWidth(AItem: TMenuItem; ACanvas: TCanvas): Integer;
begin
Result := ACanvas.TextWidth(AItem.Caption);
if not(IsMainItem(AItem)) then
begin
Result := Result + _uRightSpace + MainMenuSettings.BarWidth;
if AItem.Count > 0 then
Result := Result + _uArrowWidth;
Result := Max(Result, FMinItemWidth);
end//if
else
Result := Result + (_uRightSpace * 2);
end;//GetItemWidth
function TUCMainMenu.GetOwnerDraw: Boolean;
begin
Result := True;
end;//GetOwnerDraw
function TUCMainMenu.IsMainItem(AItem: TMenuItem): Boolean;
begin
Result := (AItem.Parent.Name = EmptyStr);
end;//IsMainItem
procedure TUCMainMenu.Loaded;
begin
inherited;
DoLoaded;
end;//Loaded
procedure TUCMainMenu.MeasureItemEvent(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
if IsMainItem(Sender as TMenuItem) then
ACanvas.Font := MainMenuSettings.MainItemFont
else
ACanvas.Font := MainMenuSettings.SubItemFont;
Width := GetItemWidth(TMenuItem(Sender), ACanvas);
Height := ACanvas.TextHeight((Sender as TMenuItem).Caption) + _uVerticalSpace * 2;
end;//MeasureItem
procedure TUCMainMenu.SetOwnerDraw(const Value: Boolean);
begin
//Do Nothing
end;//SetOwnerDraw
end.Delphi'yi açın, Tools -> Environment Options'ı açın.
Library yaprağına gelin, Library Path'e bu dosyanın olduğu klasörü ekleyin.
EnvironmentOptions'ı kapattıktan sonra Component->InstallComponent'i seçin.
IntoNewPackage yaprağını seçin.
UnitFileName'e bu UCMainMenu.pas dosyasını gösterin.
PackageFileName'i de (özetlersek) pas dosyasıyla aynı klasöre UCMainMenu_D7 adıyla belirtin.
Tamam'a tıklayın.
Bileşenin yüklendiği mesajını verecektir. Vermezse açılan pencerede önce compile edip sonra install'a tılayın.
Umarım faydasını gören olur,
kolay gelsin...
Ben yardımcı olamam ama sonuçta kaynak kodu vermişim, eğer türettiğim sınıf delphi 9'da değiştirilmediysa biraz daha araştırarak yükleyip kullanabileceğinizi tahmin ediyorum.