xpactnctrls.pas

天涯進銷存系統

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2002 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit XPActnCtrls;

interface

uses Windows, Messages, Controls, Classes, Graphics, Buttons, ActnMan,
  ActnMenus, ActnCtrls, ToolWin, ActnColorMaps, ShadowWnd;

type

{ TXPStyleMenuItem }

  TXPStyleMenuItem = class(TCustomMenuItem)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawGlyph(const Location: TPoint); override;
    procedure DrawSeparator(const Offset: Integer); override;
    procedure DrawSubMenuGlyph; override;
    procedure DrawText(var Rect: TRect; var Flags: Cardinal; Text: String); override;
    procedure DrawUnusedEdges; override;
    procedure DrawShadowedText(Rect: TRect; Flags: Cardinal; Text: String;
      TextColor: TColor; ShadowColor: TColor); override;
    procedure CalcLayout; override;
  public
    procedure CalcBounds; override;
  end;

{ TXPStyleMenuButton }

  TXPStyleMenuButton = class(TCustomMenuButton)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawText(var ARect: TRect; var Flags: Cardinal;
      Text: String); override;
  end;

{ TXPStylePopupMenu }

  TXPStylePopupMenu = class(TCustomActionPopupMenu)
  private
    FBtnShadow: TShadowWindow;
  protected
    function GetExpandBtnClass: TCustomMenuExpandBtnClass; override;
    procedure NCPaint(DC: HDC); override;
    procedure PositionPopup(AnOwner: TCustomActionBar;
      ParentItem: TCustomActionControl); override;
    procedure VisibleChanging; override;
    procedure DisplayShadow; override;
    procedure HideShadow; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

{ TXPStyleExpandBtn }

  TXPStyleExpandBtn = class(TCustomMenuExpandBtn)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawFrame(ARect: TRect; Down: Boolean); override;
  end;

{ TXPStyleButton }

  TXPStyleButton = class(TCustomButtonControl)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawFrame(ARect: TRect; Down: Boolean); override;
    procedure DrawGlyph(const Location: TPoint); override;
    procedure DrawText(var ARect: TRect; var Flags: Cardinal;
      Text: String); override;
  end;

{ TXPStyleDropDownBtn }

  TXPStyleDropDownBtn = class(TCustomDropDownButton)
  protected
    procedure DrawFrame(ARect: TRect; Down: Boolean); override;
    procedure DrawBackground(var PaintRect: TRect); override;
    function GetPopupClass: TCustomActionBarClass; override;
    procedure DrawGlyph(const Location: TPoint); override;
  end;

{ TXPStyleCustomizePopup }

  TXPStyleCustomizePopup = class(TCustomizeActionToolBar)
  protected
    procedure NCPaint(DC: HDC); override;
    function GetAddRemoveItemClass: TCustomAddRemoveItemClass; override;
    function GetDefaultColorMapClass: TCustomColorMapClass; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TXPStyleToolScrollBtn }

  TXPStyleToolScrollBtn = class(TCustomToolScrollBtn)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
  end;

{ TXPStyleAddRemoveItem }

  TXPStyleAddRemoveItem = class(TCustomAddRemoveItem)
  protected
    procedure DrawBackground(var PaintRect: TRect); override;
    procedure DrawGlyph(const Location: TPoint); override;
    procedure DrawSeparator(const Offset: Integer); override;
    procedure DrawText(var Rect: TRect; var Flags: Cardinal; Text: String); override;
    procedure DrawUnusedEdges; override;
  public
    procedure CalcBounds; override;
  end;

implementation

uses SysUtils, Forms, Consts, ActnList, GraphUtil, Contnrs, ListActns, ImgList;

function IsMouseButtonPressed: Boolean;
begin
  Result := not (((GetAsyncKeyState(VK_RBUTTON)and $8000)=0) and
            ((GetAsyncKeyState(VK_LBUTTON)and $8000)=0));
end;

{ TXPStyleMenuItem }

procedure TXPStyleMenuItem.CalcBounds;
var
  NewTextPos: TRect;
begin
  inherited;
  if Separator then
    Height := 3
  else
    Height := Height + 2;
  if not HasGlyph then
  begin
    NewTextPos := TextBounds;
    NewTextPos.Top := NewTextPos.Top + 1;
    TextBounds := NewTextPos;
  end;
end;

procedure TXPStyleMenuItem.CalcLayout;
begin
  inherited;
  GlyphPos := Point(GlyphPos.X, GlyphPos.Y + 1);
end;

procedure TXPStyleMenuItem.DrawBackground(var PaintRect: TRect);
var
  BannerRect: TRect;
  BGRect: TRect;
begin
  if (ActionClient = nil) then exit;

  if ActionClient.Color <> clDefault then
    Canvas.Brush.Color := ActionClient.Color;

  BGRect := PaintRect;
  if TextBounds.Left > GlyphPos.X then
    BGRect.Left := 0;
  BannerRect := PaintRect;
  if TextBounds.Left > GlyphPos.X then
    BannerRect.Right := TextBounds.Left - 3
  else
    BannerRect.Right := TextBounds.Right + 3;
  BannerRect.Right := 25;
  BGRect.Left := BannerRect.Right - BannerRect.Left;
//  if ActionClient.Unused then
    Canvas.Brush.Color := ActionBar.ColorMap.UnusedColor;
{  else
    Canvas.Brush.Color := ActionBar.ColorMap.Color; }
  Canvas.FillRect(BannerRect);
  Canvas.Brush.Color := Menu.ColorMap.MenuColor;

  if (Selected and Enabled) or (Selected and not MouseSelected) then
  begin
    if Enabled and not ActionBar.DesignMode then
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Dec(PaintRect.Right, 1);
  end;
  inherited DrawBackground(BGRect);
  if not Mouse.IsDragging and ((Selected and Enabled) or
     (Selected and not MouseSelected)) then
  begin
    Canvas.FillRect(PaintRect);
    Canvas.Brush.Color :=ActionBar.ColorMap.SelectedColor;
    Inc(PaintRect.Right);
    Canvas.FrameRect(PaintRect);
  end;
end;

procedure TXPStyleMenuItem.DrawGlyph(const Location: TPoint);
var
  OldColor, OldBrushColor: TColor;
  NewLocation: TPoint;
  FrameRect: TRect;
  SelBmp: TBitmap;
  ImageList: TCustomImageList;
begin
  if (Assigned(ActionClient) and not ActionClient.HasGlyph) and
     ((Action is TCustomAction) and TCustomAction(Action).Checked) then
  begin
    if IsChecked then
    begin
      FrameRect := Rect(Location.X - 1, 1, Location.X + 20, Self.Height - 1);
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
      Canvas.FillRect(FrameRect);
      Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
      Canvas.Rectangle(FrameRect);
    end;
    Canvas.Pen.Color := ActionBar.ColorMap.FontColor;
    with Location do
      DrawCheck(Canvas, Point(X + 6, Y + 3), 2)
  end
  else
  begin
    if IsChecked then
    begin
      FrameRect := Rect(Location.X - 1, 1, Location.X + 20, Self.Height - 1);
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
      Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
      Canvas.Rectangle(FrameRect);
    end;
    OldColor := Canvas.Brush.Color;
    if (Selected and Enabled) or (Selected and not MouseSelected) then
      Canvas.Brush.Color := Menu.ColorMap.SelectedColor
    else
      Canvas.Brush.Color := Menu.ColorMap.ShadowColor;
    NewLocation := Location;

    if (Selected and Enabled and ActionClient.HasGlyph) then
    begin
      OldBrushColor := Canvas.Brush.Color;
      SelBmp := TBitmap.Create;
      try
        if Assigned(ActionClient.Action) and Assigned(ActionClient.Action.ActionList) then
          ImageList := ActionClient.Action.ActionList.Images
        else
          ImageList := ActionClient.OwningCollection.ActionManager.Images;
        if Assigned(ImageList) and ImageList.GetBitmap(ActionClient.ImageIndex, SelBmp) then
        begin
          Canvas.Brush.Color := GetShadowColor(Menu.ColorMap.SelectedColor);
          SelBmp.Width := ImageList.Width;
          SelBmp.Height := ImageList.Width;
          DrawState(Canvas.Handle, Canvas.Brush.Handle, nil, SelBmp.Handle, 0,
            NewLocation.X + 3, NewLocation.Y + 2, 0, 0, DST_BITMAP or DSS_MONO);
        end;
      finally
        SelBmp.Free;
        Canvas.Brush.Color := OldBrushColor;
      end;

      Inc(NewLocation.X, 1);
      inherited DrawGlyph(NewLocation);
    end
    else begin
      Inc(NewLocation.X, 2);
      Inc(NewLocation.Y, 1);
      inherited DrawGlyph(NewLocation);
    end;
    Canvas.Brush.Color := OldColor;
  end;
end;

procedure TXPStyleMenuItem.DrawSeparator(const Offset: Integer);
var
  PaintRect: TRect;
  PR: TPenRecall;
  BR: TBrushRecall;
begin
  if Selected then
    Canvas.FillRect(ClientRect);
  BR := TBrushRecall.Create(Canvas.Brush);
  PR := TPenRecall.Create(Canvas.Pen);
  try
    if Assigned(ActionClient) and ActionClient.Unused and not Transparent then
      Canvas.Brush.Style := bsSolid
    else
    begin
      Canvas.Brush.Color := Color;
      PaintRect := BoundsRect;
      Windows.DrawEdge(Canvas.Handle, PaintRect, BDR_RAISEDINNER, BF_LEFT);
      Windows.DrawEdge(Canvas.Handle, PaintRect, BDR_RAISEDINNER, BF_RIGHT);
    end;
    Canvas.Pen.Color := Menu.ColorMap.DisabledFontColor;
    Canvas.MoveTo(32, ClientHeight div 2);
    Canvas.LineTo(ClientWidth, ClientHeight div 2);
  finally
    BR.Free;
    PR.Free;
  end;
end;

type
  TCustomActionBarType = class(TCustomActionBar);

procedure TXPStyleMenuItem.DrawShadowedText(Rect: TRect; Flags: Cardinal;
  Text: String; TextColor, ShadowColor: TColor);
begin
  OffsetRect(Rect, 6, 2);
  inherited;
end;

procedure TXPStyleMenuItem.DrawSubMenuGlyph;
const
  ArrowPos = 11;
  ArrowColor: array[Boolean] of Integer = (clBtnText, clWhite);
begin
  inherited;
  with Canvas do
  begin
    Pen.Color := Menu.ColorMap.FontColor;
    Brush.Color := Pen.Color;
  end;
  DrawArrow(Canvas, sdRight, Point(Width - ArrowPos, Height div 2 - 3), 3);
end;

procedure TXPStyleMenuItem.DrawText(var Rect: TRect; var Flags: Cardinal;
  Text: String);
begin
  OffsetRect(Rect, 6, 2);
  inherited DrawText(Rect, Flags, Text);
end;

procedure TXPStyleMenuItem.DrawUnusedEdges;
begin
end;

{ TXPStyleButton }

type
  TActionMenuBarClass = class(TCustomActionMenuBar);

procedure TXPStyleMenuButton.DrawBackground(var PaintRect: TRect);

  procedure DrawSelectedFrame;
  begin
    Canvas.Brush.Color := Menu.ColorMap.SelectedColor;
    Canvas.Pen.Color := ActionBar.ColorMap.SelectedColor;
    Canvas.Rectangle(0, 0, Width, Height);
    InflateRect(PaintRect, -1, -1);
  end;

var
  Offset: TPoint;
begin
  Canvas.Brush.Color := ActionBar.ColorMap.Color;
  if (ActionBar is TCustomActionMenuBar) and
    TCustomActionMenuBar(ActionBar).InMenuLoop then
  begin
    if Selected then
      if ActionClient.ChildActionBar = nil then
      begin
        if TActionMenuBarClass(Menu.RootMenu).PopupStack.Count = 1 then
        begin
          Canvas.Brush.Color :=ActionBar.ColorMap.SelectedColor;
          DrawSelectedFrame;
        end;
      end
      else
      begin
        Canvas.Brush.Color :=ActionBar.ColorMap.SelectedColor;
        Canvas.Pen.Color := ActionBar.ColorMap.BtnFrameColor;
        Canvas.Rectangle(0, 0, Width, Height);
        Offset := Parent.ClientToScreen(BoundsRect.TopLeft);
        if Offset.Y >= ActionClient.ChildActionBar.BoundsRect.Bottom then
          Offset.Y := 0
        else
          Offset.Y := Height - 1;
        Canvas.Pen.Color := ActionBar.ColorMap.BtnSelectedColor;
        Canvas.MoveTo(1, Offset.Y);
        Canvas.LineTo(Width-1, Offset.Y);
        InflateRect(PaintRect, -1, -1);
      end;
  end
  else if MouseInControl then
    DrawSelectedFrame;
  inherited DrawBackground(PaintRect);
end;

procedure TXPStyleMenuButton.DrawText(var ARect: TRect; var Flags: Cardinal;
  Text: String);
begin
  OffsetRect(ARect, 1, 0);
  inherited DrawText(ARect, Flags, Text);
  if (Self.MouseInControl)  then
     Self.Canvas.Font.Color :=clWhite
  else
  if Self.Selected then
     Self.Canvas.Font.Color :=clWhite
  else
     Self.Canvas.Font.Color :=clBlack;
  Windows.DrawText(Canvas.Handle, PChar(Text), Length(Text), ARect, Flags);
end;

{ TXPStylePopupMenu }

constructor TXPStylePopupMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  VertMargin := 0;
end;

destructor TXPStylePopupMenu.Destroy;
begin
  FreeAndNil(FBtnShadow);
  inherited;
end;

procedure TXPStylePopupMenu.DisplayShadow;
begin
  inherited;
{  if not Shadow or DesignMode then exit;
  if Assigned(ActionClient) and (ActionClient is TActionClientItem) and
    (TActionClientItem(ActionClient).Control is TCustomMenuButton) then
    if not Assigned(FBtnShadow) then
      FBtnShadow := TShadowWindow.CreateShadow(Self, csRight);
  if Assigned(FBtnShadow) then
    FBtnShadow.Control := TActionClientItem(ActionClient).Control;}
end;

function TXPStylePopupMenu.GetExpandBtnClass: TCustomMenuExpandBtnClass;
begin
  Result := TXPStyleExpandBtn;
end;

procedure TXPStylePopupMenu.HideShadow;
begin
  inherited;
  if Assigned(FBtnShadow) then
    FBtnShadow.Hide;
end;

procedure TXPStylePopupMenu.NCPaint(DC: HDC);
var
  RC, RW: TRect;
  OldHandle: THandle;
  Offset: TPoint;
begin
  Windows.GetClientRect(Handle, RC);
  GetWindowRect(Handle, RW);
  MapWindowPoints(0, Handle, RW, 2);
  OffsetRect(RC, -RW.Left, -RW.Top);
  ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  { Draw border in non-client area }
  OffsetRect(RW, -RW.Left, -RW.Top);
  OldHandle := Canvas.Handle;
  try
    Canvas.Handle := DC;
    Canvas.Pen.Width := 1;

    Canvas.Pen.Color := ColorMap.FrameTopLeftOuter;
    Canvas.MoveTo(RW.Right, RW.Top);
    Canvas.LineTo(RW.Left, Rw.Top);
    Canvas.LineTo(RW.Left, RW.Bottom);

    Canvas.Pen.Color := ColorMap.FrameTopLeftInner;
    Canvas.MoveTo(RW.Right - 1, RW.Top + 1);
    Canvas.LineTo(RW.Left + 1, Rw.Top + 1);
    Canvas.LineTo(RW.Left + 1, RW.Bottom - 2);

    Canvas.Pen.Color := ColorMap.FrameBottomRightOuter;
    Canvas.MoveTo(RW.Right - 1, RW.Top);
    Canvas.LineTo(RW.Right - 1, RW.Bottom - 1);
    Canvas.LineTo(RW.Left - 1, RW.Bottom - 1);

    Canvas.Pen.Color := ColorMap.FrameBottomRightInner;