⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ksskinmenus.pas

📁 小区水费管理系统源代码水费收费管理系统 水费收费管理系统
💻 PAS
字号:
{==============================================================================

  SkinEngine's Menus
  Copyright (C) 2000-2002 by Evgeny Kryukov
  All rights reserved

  All conTeThements of this file and all other files included in this archive
  are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

  $Id: KsSkinMenus.pas,v 1.5 2002/10/28 21:04:21 Evgeny Exp $

===============================================================================}

unit KsSkinMenus;

{$I se_define.inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
  Menus, ImgList, se_controls, KsSkinItems, KsSkinVersion, KsSkinObjects,
  KsSkinSource, KsSkinEngine;

type

{ TSeSkinMenuBar class }

{ TSeSkinMenuBar is a menu bar and its accompanying drop-down menus for a form. }
  TSeSkinMenuBar = class(TSeCustomMenuBar)
  private
    FSkinEngine: TSeSkinEngine;
    FSkinMenuBar: TSeSkinObject;
    FSkinObject: string;
    function GetVersion: TSeSkinVersion;
    procedure SetVersion(const Value: TSeSkinVersion);
    procedure SetSkinEngine(const Value: TSeSkinEngine);

    procedure WMInvalidateSkinObject(var Msg: TMessage); message WM_INVALIDATESKINOBJECT;
    procedure WMBeforeChange(var Msg: TMessage); message WM_BEFORECHANGE;
    procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;
    procedure SetSkinObject(const Value: string);
  protected
    function UseSkin: boolean;
    { need for }
    class procedure GetItemClassProc(var AItemClass: TSeCustomItemClass); override;
    { Protected }
    procedure ItemsChanged; override;
    function GetViewRect: TRect; override;
    procedure PaintBuffer; override;
    { VCL protected  }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Align;
    property Anchors;
    property Images;
    property Items;
    property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
    property SkinObject: string read FSkinObject write SetSkinObject;
    property Version: TSeSkinVersion read GetVersion write SetVersion stored False;
  end;

{ TSeSkinPopupMenu class }

{ TSeSkinPopupMenu encapsulates the properties, methods, and events of a advanced pop-up menu. }
  TSeSkinPopupMenu = class(TSeCustomPopupMenu)
  private
    FSkinEngine: TSeSkinEngine;
    function GetVersion: TSeSkinVersion;
    procedure SetVersion(const Value: TSeSkinVersion);
    procedure SetSkinEngine(const Value: TSeSkinEngine);
  protected
    { need for }
    class procedure GetItemClassProc(var AItemClass: TSeCustomItemClass); override;
    { VCL protected  }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure Popup(X, Y: integer); override;
  published
    property Items;
    property Images;
    { Link to TSeSkinEngine component. Specifies the appearance and behavior by using specified skins from TSeSkinEngine components
      See Also
        TSeSkinEngine
    }
    property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
    property Version: TSeSkinVersion read GetVersion write SetVersion stored False;
  end;

implementation {===============================================================}

//uses KsControlBars;

{ TSeSkinMenuBar ===============================================================}

constructor TSeSkinMenuBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSkinObject := 'MenuBar';
end;

destructor TSeSkinMenuBar.Destroy;
begin
  inherited Destroy;
end;

procedure TSeSkinMenuBar.Loaded;
begin
  inherited Loaded;
  SkinEngine := FSkinEngine;
end;

class procedure TSeSkinMenuBar.GetItemClassProc(var AItemClass: TSeCustomItemClass); 
begin
  AItemClass := TSeSkinItem;
end;

procedure TSeSkinMenuBar.ItemsChanged;
begin
  (Items as TSeSkinItem).SkinEngine := FSkinEngine;
  inherited;
end;

{ Internal }

function TSeSkinMenuBar.UseSkin: boolean;
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then
    Result := false
  else
    if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
       (not FSkinEngine.SkinSource.IsChanging) and
       (FSkinEngine.SkinSource.Count > 0) and
       (FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil) and
       (FSkinMenuBar <> nil)
    then
      Result := true
    else
      Result := false;
end;

procedure TSeSkinMenuBar.PaintBuffer;
var
  SkinObject: TSeSkinObject;
begin
  if UseSkin then
  begin
    if Parent is TSeCustomControlBar then
      SkinObject := FSkinMenuBar.FindObjectByName('ToolbarFrame')
    else
      SkinObject := FSkinMenuBar.FindObjectByName('Frame');

    if SkinObject <> nil then
    begin
      SkinObject.BoundsRect := Rect(0, 0, FWidth, FHeight);
      SkinObject.Draw(Canvas);
    end;

    if (View <> nil) then
    begin
      with GetViewRect do
      begin
        View.Left := Left;
        View.Top := Top;
      end;
      View.Paint(Canvas);
    end;
  end
  else
    inherited ;
end;

function TSeSkinMenuBar.GetViewRect: TRect;
begin
  if UseSkin and (FSkinMenuBar.FindObjectByName('Frame') <> nil) then
    with FSkinMenuBar.FindObjectByName('Frame') do
    begin
      Result := Rect(MarginLeft, MarginTop, Width - MarginRight, Height - MarginBottom);
    end
  else
    Result := inherited GetViewRect;
end;

procedure TSeSkinMenuBar.WMInvalidateSkinObject(var Msg: TMessage);
begin
  Invalidate;
end;

procedure TSeSkinMenuBar.WMBeforeChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  if FSkinMenuBar <> nil then FSkinMenuBar.Free;
  FSkinMenuBar := nil;
  TSeSkinItem(Items).SkinEngine := FSkinEngine;
end;

procedure TSeSkinMenuBar.WMSkinChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  SkinEngine := FSkinEngine;
end;

{ VCL protected }

procedure TSeSkinMenuBar.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSkinEngine) then
  begin
    SkinEngine := nil;
    Invalidate;
  end;
end;

{ Properties }

function TSeSkinMenuBar.GetVersion: TSeSkinVersion;
begin
  Result := sSeSkinVersion;
end;

procedure TSeSkinMenuBar.SetSkinEngine(const Value: TSeSkinEngine);
begin
  FSkinEngine := Value;
  TSeSkinItem(Items).SkinEngine := Value;

  if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
     (not FSkinEngine.SkinSource.IsChanging) and
     (FSkinEngine.SkinSource.Count > 0) then
  begin
    if FSkinMenuBar <> nil then FSkinMenuBar.Free;
    FSkinMenuBar := nil;

    if FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil then
      FSkinMenuBar := FSkinEngine.SkinSource.GetObjectByName(FSkinObject).CreateCopy(nil);

    if FSkinMenuBar <> nil then
    begin
      FSkinMenuBar.ParentControl := Self;
      if (FSkinMenuBar.FindObjectByName('Frame') <> nil) then
      begin
        Height := FSkinMenuBar.FindObjectByName('Frame').Height;
        if View <> nil then
        begin
          View.CalcSize;
          with GetViewRect do
          begin
            View.Left := Left;
            View.Top := Top;
          end;
          View.CalcSize;
        end;
      end;
    end;
  end
  else
  begin
    if FSkinMenuBar <> nil then FSkinMenuBar.Free;
    FSkinMenuBar := nil;
  end;

  Invalidate;
end;

procedure TSeSkinMenuBar.SetVersion(const Value: TSeSkinVersion);
begin
end;

procedure TSeSkinMenuBar.SetSkinObject(const Value: string);
begin
  FSkinObject := Value;
end;

{ TSeSkinPopupMenu ==========================================================}

constructor TSeSkinPopupMenu.Create(AOwner: TComponent);
begin
  inherited;
end;

destructor TSeSkinPopupMenu.Destroy;
begin
  inherited;
end;

class procedure TSeSkinPopupMenu.GetItemClassProc(var AItemClass: TSeCustomItemClass);
begin
  AItemClass := TSeSkinItem;
end;

function TSeSkinPopupMenu.GetVersion: TSeSkinVersion;
begin
  Result := sSeSkinVersion;
end;

procedure TSeSkinPopupMenu.Loaded;
begin
  inherited;
  SkinEngine := FSkinEngine;
end;

procedure TSeSkinPopupMenu.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSkinEngine) then SkinEngine := nil;
end;

procedure TSeSkinPopupMenu.SetSkinEngine(const Value: TSeSkinEngine);
begin
  FSkinEngine := Value;
  TSeSkinItem(Items).SkinEngine := SkinEngine;
end;

procedure TSeSkinPopupMenu.SetVersion(const Value: TSeSkinVersion);
begin
end;

procedure TSeSkinPopupMenu.Popup(X, Y: integer);
begin
  SkinEngine := FSkinEngine;
  
  inherited Popup(X, Y);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -