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

Question

看到一些美丽的界面设计，比如一些美丽的菜单设计，那么在Delphi中如何实现呢，不用控件格式的菜单。如何把菜单作成那种，譬如有些网页的菜单样式，怎么在用Delphi做的程序中实现？

Answer 1

unit Unit1;interfaceuses
  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);
  

Answer 2

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.