程序的界面如何与具体的处理动作联系起来的?

yofochow 2005-01-02 02:18:27
看到一些美丽的界面设计,比如一些美丽的菜单设计,那么在Delphi中如何实现呢,不用控件格式的菜单。如何把菜单作成那种,譬如有些网页的菜单样式,怎么在用Delphi做的程序中实现?
...全文
98 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
yofochow 2005-01-02
  • 打赏
  • 举报
回复
感激啊。
jackie168 2005-01-02
  • 打赏
  • 举报
回复
if FMenu is TMainMenu then
for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do
if FMenuItem.GetParentMenu.Items[i] = FMenuItem then
begin
ACanvas.brush.color := FIConBackColor;
ACanvas.FillRect(ARect);
if (FMenuItem.ImageIndex = -1) and (FMenuItem.Bitmap.width = 0) then
begin
TextRect := ARect;
break;
end;
end;

ACanvas.brush.color := FIconBackColor;
ACanvas.FillRect(IconRect);

if FMenuItem.Enabled then
ACanvas.Font.Color := FFontColor
else
ACanvas.Font.Color := FDisabledFontColor;

if Selected then
begin
ACanvas.brush.Style := bsSolid;
ACanvas.brush.color := FSelectedBkColor;
ACanvas.FillRect(TextRect);

ACanvas.Pen.color := FSelectedFontColor;

ACanvas.Brush.Style := bsClear;
ACanvas.RoundRect(TextRect.Left, TextRect.top, TextRect.Right,
TextRect.Bottom, 6, 6);

if FMenuItem.Enabled then
ACanvas.Font.Color := FSelectedFontColor;
end;

X1 := IConRect.Left + 2;
if B <> nil then
ACanvas.Draw(X1, IConRect.top + 1, B);

if FMenuItem.Checked then
begin
ACanvas.Pen.color := FCheckedColor;
ACanvas.Brush.Style := bsClear;
ACanvas.RoundRect(IconRect.Left, IconRect.top, IconRect.Right,
IconRect.Bottom, 3, 3);
end;

if not FMenuItem.IsLine then
begin
SetBkMode(ACanvas.Handle, TRANSPARENT);

ACanvas.Font.Name := 'Tahoma';
if FMenu.IsRightToLeft then
ACanvas.Font.Charset := ARABIC_CHARSET;

if FMenu.IsRightToLeft then
TextFormat := DT_RIGHT + DT_RTLREADING
else
TextFormat := 0;


if FMenuItem.Default then
begin
Inc(TextRect.Left, 1);
Inc(TextRect.Right, 1);
Inc(TextRect.Top, 1);
ACanvas.Font.color := clGray;
DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);

Dec(TextRect.Left, 1);
Dec(TextRect.Right, 1);
Dec(TextRect.Top, 1);

ACanvas.Font.color := FFontColor;
end;

DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);

txt := ShortCutToText(FMenuItem.ShortCut) + ' ';

if FMenu.IsRightToLeft then
TextFormat := DT_LEFT
else
TextFormat := DT_RIGHT;

DrawtextEx(ACanvas.Handle,
PChar(txt),
Length(txt),
TextRect, TextFormat, nil);
end
else
begin
ACanvas.Pen.Color := FSeparatorColor;
ACanvas.MoveTo(ARect.Left + 10,
TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2));
ACanvas.LineTo(ARect.Right - 2,
TextRect.Top +
Round((TextRect.Bottom - TextRect.Top) / 2))
end;
B.free;
end;


procedure TForm1.MenueDrawItemX(xMenu: TMenu);
var
i: integer;
B: TBitmap;
FMenuItem: TMenuItem;
begin
B := TBitmap.Create;
B.Width := 1;
B.Height := 1;

for i := 0 to ComponentCount - 1 do
if Components[i] is TMenuItem then
begin
FMenuItem := TMenuItem(Components[i]);
FMenuItem.OnDrawItem := DrawItem;
if (FMenuItem.ImageIndex = -1) and
(FMenuItem.Bitmap.width = 0) and (xMenu <> nil) then
if FMenuItem.GetParentComponent.Name <> xMenu.Name then
FMenuItem.Bitmap.Assign(b);
end;
B.Free;
DrawMenuBar(handle);
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var
p: TPoint;
col: DWOrd;
MDC: HDC;
begin
MDC := GetDC(0);
GetCursorPos(p);
col := GetPixel(MDC, p.x, p.y);
panel1.Color:=ColorToRGB(col);
edit1.text:=inttostr(col);
panel2.color:= 7381139 ;
end;

end.
jackie168 2005-01-02
  • 打赏
  • 举报
回复
unit Unit1;

interface

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

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
ImageList1: TImageList;
FileMenu1: TMenuItem;
test1: TMenuItem;
N11: TMenuItem;
a1: TMenuItem;
Timer1: TTimer;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
Panel2: TPanel;
SkinData1: TSkinData;
procedure FormCreate(Sender: TObject);
procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
procedure MenueDrawItemX(xMenu: TMenu);
public
{ Public declarations }
procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
begin
MenueDrawItem(Sender, ACanvas, ARect, Selected);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MenueDrawItemX(Menu);
MainMenu1.OwnerDraw:=true;
end;

procedure TForm1.MenueDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
txt: string;
B: TBitmap;

IConRect, TextRect: TRect;
FBackColor, FIconBackColor, FSelectedBkColor, FFontColor, FSelectedFontColor,
FDisabledFontColor, FSeparatorColor, FCheckedColor: TColor;

i, X1, X2: integer;
TextFormat: integer;
HasImgLstBitmap: boolean;
FMenuItem: TMenuItem;
FMenu: TMenu;

begin
FMenuItem := TMenuItem(Sender);
FMenu := FMenuItem.Parent.GetParentMenu;

FBackColor := $00E1E1E1; //背景色
FIconBackColor := $00D1D1D1; //图标背景
FSelectedBkColor := $00DCCFC7; //选择的颜色

FFontColor := clBlack; //字体颜色
FSelectedFontColor := clGray; //选择字体及边框的颜色
FDisabledFontColor := clGray; //禁止的字体颜色
FSeparatorColor := $00D1D1D1;
FCheckedColor := clGray;

if FMenu.IsRightToLeft then
begin
X1 := ARect.Right - 20;
X2 := ARect.Right;
end
else
begin
X1 := ARect.Left;
X2 := ARect.Left + 20;
end;
IConRect := Rect(X1, ARect.Top, X2, ARect.Bottom);

TextRect := ARect;
txt := ' ' + FMenuItem.Caption;

B := TBitmap.Create;

B.Transparent := True;
B.TransparentMode := tmAuto;

HasImgLstBitmap := false;
if (FMenuItem.Parent.GetParentMenu.Images <> nil) or
(FMenuItem.Parent.SubMenuImages <> nil) then
begin
if FMenuItem.ImageIndex <> -1 then
HasImgLstBitmap := true
else
HasImgLstBitmap := false;
end;

if HasImgLstBitmap then
begin
if FMenuItem.Parent.SubMenuImages <> nil then
FMenuItem.Parent.SubMenuImages.GetBitmap(FMenuItem.ImageIndex, B)
else
FMenuItem.Parent.GetParentMenu.Images.GetBitmap(FMenuItem.ImageIndex, B)
end
else
if FMenuItem.Bitmap.Width > 0 then
B.Assign(TBitmap(FMenuItem.Bitmap));

if FMenu.IsRightToLeft then
begin
X1 := ARect.Left;
X2 := ARect.Right - 20;
end
else
begin
X1 := ARect.Left + 20;
X2 := ARect.Right;
end;
TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom);

ACanvas.brush.color := FBackColor;
ACanvas.FillRect(TextRect);

jackie168 2005-01-02
  • 打赏
  • 举报
回复
为什么发在非技术区?

830

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 非技术区
社区管理员
  • 非技术区社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧