منوی آفیس ۲۰۰۷ در دلفی

ارسال شده در ۱۸ خرداد ۱۳۹۵ / دسته بندی: دانلود / ۲ دیدگاه


یکی از نکاتی که باعث زیبایی ظاهر یک برنامه میشود، استفاده از المان های گرافیکی در طراحی واسط کاربری (User Interface) میباشد. طوری که ظاهر و کاربری زیبا  میتواند تجربه استفاده راحت تری را برای کاربران نرم افزار فراهم کند.

منوی آفیس ۲۰۰۷ در دلفی

در این مطلب، نمونه ای از شبیه سازی منوی کلیک راست نرم افزار Office 2007 را در نرم افزار برنامه نویسی Delphi برایتان آماده کرده ایم که میتوانید برای یادگیری و استفاده از آن در نرم افزارهای خودتان استفاده کنید. همچنین با درک عملکرد این برنامه، میتوانید به راحتی سایر منوها و ابزارها را در نرم افزارتان شبیه سازی کنید.

 

منوی آفیس 2007 در دلفی

 

در ادامه میتوانید سورس کد را مشاهده کنید. همچنین در انتها فایل دانلود پروژه در اختیارتان قرار گرفته است.

// EEGroup.ir
// Copyright by Erikeh Engineering Group.

unit main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, ImgList, StdCtrls;

type
TfrmRichMenu = class(TForm)
panelMenu: TPanel;
imgList: TImageList;
menuRich: TPopupMenu;
N1: TMenuItem;
FreezePanes1: TMenuItem;
FreezeTopRow1: TMenuItem;
FreezeFirstColumn1: TMenuItem;
N2: TMenuItem;
SplitWindow1: TMenuItem;
panelOptions: TPanel;
cbTextSep: TCheckBox;
cbInlineDesc: TCheckBox;
cbImages: TCheckBox;
cbOwnerDraw: TCheckBox;
cbShortCuts: TCheckBox;
procedure MeasureSeparator(Sender: TObject; ACanvas: TCanvas; var Width,
Height: Integer);
procedure SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure cbOwnerDrawClick(Sender: TObject);
procedure cbImagesClick(Sender: TObject);
procedure cbTextSepClick(Sender: TObject);
procedure cbInlineDescClick(Sender: TObject);
procedure cbShortCutsClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmRichMenu: TfrmRichMenu;

implementation

uses
Math, JclGraphics;

{$R *.dfm}

const
RICHMENU_MARG_X                     = ۴;
RICHMENU_MARG_Y                     = ۲;
RICHMENU_SEPARATOR_LEADING          = ۶;
RICHMENU_GUTTER_WIDTH               = ۲۶;

RICHMENU_SEPARATOR_BACKGROUND_COLOR = $۰۰eee7dd;
RICHMENU_SEPARATOR_LINE_COLOR       = $۰۰c5c5c5;
RICHMENU_GUTTER_COLOR               = $۰۰eeeee9;
RICHMENU_ITEM_BACKGROUND_COLOR      = $۰۰fafafa;
RICHMENU_ITEM_SELECTED_COLOR        = $۰۰e6d5cb;
RICHMENU_FONT_COLOR                 = $۰۰۶e1500;
RICHMENU_FONT_DISABLED_COLOR        = $۰۰dec5d8;

RICHMENU_GRADIENT_START1            = $۰۰efe8e4;
RICHMENU_GRADIENT_END1              = $۰۰dec5b8;
RICHMENU_GRADIENT_START2            = $۰۰d8baab;
RICHMENU_GRADIENT_END2              = $۰۰efe8e4;

//
//Measure width and height of a menuseparator
//
procedure TfrmRichMenu.MeasureSeparator(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
SeparatorHint: string;
item: TMenuItem;
r: TRect;
begin
item := TMenuItem(sender);
SeparatorHint := item.Hint;

//Separator with text:
if SeparatorHint <> '' then
begin
//Initialize
r := rect(0, ۰, ۰, ۰);
ACanvas.Font.Style := [fsBold];

//Make windows calculate needed space
Height := drawText(ACanvas.Handle, PChar(SeparatorHint), length(SeparatorHint), r, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
width := r.Right - r.Left;

//Give some extra room for padding:
inc(Height, RICHMENU_MARG_Y*4);
inc(Width,  RICHMENU_MARG_X*2 + RICHMENU_SEPARATOR_LEADING);
end
else
//Plain old separator:
begin
//Fixed height and width:
height := ۴;
width := ۱۰;
end;
end;

//
// Drawing a menuseparator
//
procedure TfrmRichMenu.SeparatorDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
hintStr: string;
item: TMenuItem;
r: TRect;
hasGutter: boolean;
begin
item := TMenuItem(sender);
hasGutter := item.GetImageList <> nil;

//Background:
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := RICHMENU_SEPARATOR_BACKGROUND_COLOR;
ACanvas.FillRect(ARect);

//Lines:
ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
ACanvas.Polyline([point(ARect.Left, ARect.Bottom-2), point(ARect.Right, ARect.Bottom-2)]);
ACanvas.Pen.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
ACanvas.Polyline([point(ARect.Left, ARect.Bottom-1), point(ARect.Right, ARect.Bottom-1)]);

//Text
hintStr := item.Hint;
if hintStr <> '' then
begin
//Text:
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Style := [fsBold];
ACanvas.Font.Color := RICHMENU_FONT_COLOR;
r.Left := ARect.Left + RICHMENU_MARG_X;
if hasGutter then
inc(r.Left, RICHMENU_SEPARATOR_LEADING);
r.Right := ARect.Right - RICHMENU_MARG_X;
r.Top := ARect.Top;
r.Bottom := ARect.Bottom;
DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_SINGLELINE or DT_VCENTER);
end
else if hasGutter then
begin
//Gutter
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
r := ARect;
r.Right := RICHMENU_GUTTER_WIDTH;
ACanvas.FillRect(r);

ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
end;
end;

//
// Measure a menuitems width and height
//
procedure TfrmRichMenu.MenuItemMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
item: TMenuItem;

captionStr: string;
captionRect: TRect;
captionHeight: integer;
captionWidth: integer;

hintStr: string;
hintRect: TRect;
hintHeight: integer;
hintWidth: integer;

shortCutStr: string;
shortCutRect: TRect;
shortCutHeight: integer;
shortCutWidth: integer;
begin
item := TMenuItem(sender);

//Caption
captionStr := item.Caption;
captionRect := rect(0, ۰, ۰, ۰);
ACanvas.Font.Style := [fsBold];

captionHeight := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), captionRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
captionWidth  := captionRect.Right - captionRect.Left;

//Shortcut:
shortCutStr := ShortCutToText(item.ShortCut);
if shortCutStr <> '' then
begin
shortCutRect := rect(0, ۰, ۰, ۰);
shortCutHeight := DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), shortCutRect, DT_CALCRECT or DT_RIGHT or DT_EXTERNALLEADING);
shortCutWidth := shortCutRect.Right - shortCutRect.Left;
inc(captionWidth, shortCutWidth + RICHMENU_MARG_X*2);
end;

//Hint:
hintRect := rect(0, ۰, ۰, ۰);
hintStr := item.Hint;
ACanvas.Font.Style := [];

hintHeight := DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), hintRect, DT_CALCRECT or DT_LEFT or DT_EXTERNALLEADING);
hintWidth  := hintRect.Right - hintRect.Left;

width := Max(captionWidth, hintWidth) + RICHMENU_MARG_X*2;
if item.GetImageList <> nil then
inc(width, RICHMENU_GUTTER_WIDTH);

height := captionHeight + hintHeight + RICHMENU_MARG_Y*4;
end;

//
// Drawing a menuitem
//
procedure TfrmRichMenu.MenuItemDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
i: integer;
hintStr: string;
captionStr: string;
shortCutStr: string;
r: TRect;
offset: integer;
selRgn: HRGN;
fillRgn: HRGN;
hasGutter: boolean;
item: TMenuItem;
begin
item := TMenuItem(sender);
hintStr := item.Hint;
captionStr := item.Caption;
hasGutter := item.GetImageList <> nil;

//Caption-hight:
ACanvas.Font.Style := [fsBold];
r := rect(0, ۰, ۰, ۰);
offset := DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_CALCRECT or DT_EXTERNALLEADING or DT_TOP);

//Backgrount
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := RICHMENU_ITEM_BACKGROUND_COLOR;
ACanvas.FillRect(ARect);

//Gutter
if hasGutter then
begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := RICHMENU_GUTTER_COLOR;
r := ARect;
r.Right := RICHMENU_GUTTER_WIDTH;
ACanvas.FillRect(r);

ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
ACanvas.Polyline([point(r.Right, r.top), point(r.Right, r.Bottom)]);
end;

//Selection
if selected then
begin
//Set a rounded rectangle as clip-region
selRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ۳, ۳);
SelectClipRgn(ACanvas.Handle, selRgn);

if hintStr <> '' then
begin
//First gradient - caption
r := ARect;
r.Bottom := r.Top + offset + RICHMENU_MARG_Y*2;
FillGradient(ACanvas.Handle, r, ۲۵۶, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);

//Second gradient - description
r.Top := r.Bottom;
r.Bottom := ARect.Bottom;
FillGradient(ACanvas.Handle, r, ۲۵۶, RICHMENU_GRADIENT_START2, RICHMENU_GRADIENT_END2, gdVertical);
end
else
begin
//Only one gradient under captoin
r := ARect;
FillGradient(ACanvas.Handle, r, ۲۵۶, RICHMENU_GRADIENT_START1, RICHMENU_GRADIENT_END1, gdVertical);
end;

//Release clipregion
SelectClipRgn(ACanvas.Handle, ۰);

//Outline selection
ACanvas.Pen.Color := RICHMENU_SEPARATOR_LINE_COLOR;
ACanvas.Brush.Style := bsClear;
ACanvas.RoundRect(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom, ۳, ۳);
end;

//Caption
ACanvas.Brush.Style := bsClear;
ACanvas.Font.Style := [fsBold];
if item.Enabled then
ACanvas.Font.Color := RICHMENU_FONT_COLOR
else
ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
r.Left := ARect.Left + RICHMENU_MARG_X;
if hasGutter then
inc(r.Left, RICHMENU_GUTTER_WIDTH);
r.Right := ARect.Right - RICHMENU_MARG_X;
r.Top := ARect.Top + RICHMENU_MARG_Y;
r.Bottom := ARect.Bottom;
DrawText(ACanvas.Handle, PChar(captionStr), length(captionStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

//Shortcut
shortCutStr := ShortCutToText(item.ShortCut);
if shortCutStr <> '' then
begin
DrawText(ACanvas.Handle, PChar(shortCutStr), length(shortCutStr), r, DT_RIGHT or DT_EXTERNALLEADING or DT_TOP);
end;

//Hint
ACanvas.Font.Style := [];
if item.Enabled then
ACanvas.Font.Color := RICHMENU_FONT_COLOR
else
ACanvas.Font.Color := RICHMENU_FONT_DISABLED_COLOR;
r.Left := ARect.Left + RICHMENU_MARG_X;
if hasGutter then
inc(r.Left, RICHMENU_GUTTER_WIDTH);
r.Right := ARect.Right - RICHMENU_MARG_X;
r.Top := ARect.Top + offset + RICHMENU_MARG_Y*2;
r.Bottom := ARect.Bottom;
DrawText(ACanvas.Handle, PChar(hintStr), length(hintStr), r, DT_LEFT or DT_EXTERNALLEADING or DT_TOP);

//Icon
if (item.ImageIndex >= ۰) and (item.GetImageList <> nil) then
begin
item.GetImageList.Draw(ACanvas, ARect.Left + RICHMENU_MARG_X, ARect.Top + RICHMENU_MARG_Y, item.ImageIndex);
end;
end;

//
// Code to enable/disable customdrawing etc
//

procedure TfrmRichMenu.cbOwnerDrawClick(Sender: TObject);
begin
menuRich.OwnerDraw := cbOwnerDraw.Checked;
if cbOwnerDraw.Checked then
begin
FreezePanes1.OnDrawItem       := MenuItemDrawItem;
FreezeTopRow1.OnDrawItem      := MenuItemDrawItem;
FreezeFirstColumn1.OnDrawItem := MenuItemDrawItem;
SplitWindow1.OnDrawItem       := MenuItemDrawItem;
N1.OnDrawItem                 := SeparatorDrawItem;
N2.OnDrawItem                 := SeparatorDrawItem;
end
else
begin
FreezePanes1.OnDrawItem       := nil;
FreezeTopRow1.OnDrawItem      := nil;
FreezeFirstColumn1.OnDrawItem := nil;
SplitWindow1.OnDrawItem       := nil;
N1.OnDrawItem                 := nil;
N2.OnDrawItem                 := nil;
end;

cbInlineDesc.Enabled := cbOwnerDraw.Checked;
cbTextSep.Enabled := cbOwnerDraw.Checked;

if not cbInlineDesc.Enabled then
cbInlineDesc.Checked := false;

if not cbTextSep.Enabled then
cbTextSep.Checked := false;
end;

procedure TfrmRichMenu.cbImagesClick(Sender: TObject);
begin
if cbImages.Checked then
menuRich.Images := imgList
else
menuRich.Images := nil;
end;

procedure TfrmRichMenu.cbTextSepClick(Sender: TObject);
begin
if cbTextSep.Checked then
begin
N1.Hint := 'Freeze Panes';
N2.Hint := 'Split Window';
end
else
begin
N1.Hint := '';
N2.Hint := '';
end;

end;

procedure TfrmRichMenu.cbInlineDescClick(Sender: TObject);
begin
if cbInlineDesc.Checked then
begin
FreezePanes1.Hint       := 'Keep rows and columns visible while the rest of'#13#10'the worksheet scrolls (based on current selection).';
FreezeTopRow1.Hint      := 'Keep the top row visible while scrolling through'#13#10'the rest of the worksheet.';
FreezeFirstColumn1.Hint := 'Keep the first column visible while scrolling'#13#10'through the rest of the worksheet.';
SplitWindow1.Hint       := 'Split the window into four quadrants that can'#13#10'be scrolled through independently.';
end
else
begin
FreezePanes1.Hint       := '';
FreezeTopRow1.Hint      := '';
FreezeFirstColumn1.Hint := '';
SplitWindow1.Hint       := '';
end;
end;

procedure TfrmRichMenu.cbShortCutsClick(Sender: TObject);
begin
if cbShortCuts.Checked then
begin
FreezePanes1.ShortCut       := ShortCut(VK_F1, [ssCtrl]);
FreezeTopRow1.ShortCut      := ShortCut(VK_F2, [ssCtrl]);
FreezeFirstColumn1.ShortCut := ShortCut(VK_F3, [ssCtrl]);
SplitWindow1.ShortCut       := ShortCut(VK_F4, [ssCtrl]);
end
else
begin
FreezePanes1.ShortCut       := ۰;
FreezeTopRow1.ShortCut      := ۰;
FreezeFirstColumn1.ShortCut := ۰;
SplitWindow1.ShortCut       := ۰;
end;
end;

end.
Delphi-office-2007
Delphi-office-2007
2007ownerdraw.rar
308.6 KiB
0 Downloads
اطلاعات بیشتر

2 دیدگاه در “منوی آفیس ۲۰۰۷ در دلفی

پاسخ دادن به حمید لغو پاسخ

نشانی ایمیل شما منتشر نخواهد شد. بخش‌های موردنیاز علامت‌گذاری شده‌اند *

Time limit is exhausted. Please reload CAPTCHA.