ucxpstyle.pas

delphi 控件有需要的可以下载看看,可以用的,希望对你用 帮助

  FDisableSubclassing := false;        // enable XPStyle to be used for global subclassing

{moved to UCXPSettings
 {$IFDEF VER5U
  FFont.Assign(Screen.MenuFont);
 {$ELSE
   GetSystemMenuFont(FFont);
 {$ENDIF
}

  FForm := (Owner as TScrollingWinControl);
  FUCXPSettings := TUCXPSettings.create(self); //added by fduenas
  {moved to UCXPSettings
  FUseSystemColors := true;

  FColor := clBtnFace;
  FIconBackColor := clBtnFace;
  FSelectColor := clHighlight;
  FSelectBorderColor := clHighlight;
  FMenuBarColor := clBtnFace;
  FDisabledColor := clInactiveCaption;
  FSeparatorColor := clBtnFace;
  FCheckedColor := clHighlight;
  FSelectFontColor := FFont.Color;
  FGrayLevel := 10;
  FDimLevel := 30;
  FIconWidth := 24;
  FDrawSelect := true;
  UCXPContainers := [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
                  xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller];
  UCXPControls := [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo, xcListBox,
                xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcMiscEdit, xcCheckBox,
                xcRadioButton, xcButton, xcBitBtn, xcSpeedButton, xcUpDown, xcPanel,
                xcGroupBox, xcTreeView, xcListView, xcProgressBar, xcHotKey];
            {xcStringGrid, xcDrawGrid, xcDBGrid];

  }
  if Assigned(FForm) then
    SetGlobalColor(TForm(FForm).Canvas);

// +jt
// FTransparentColor := clFuchsia;
 FUCXPSettings.ColorsChanged := false;
 OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
 GetVersionEx(OSVersionInfo);
 FIsWXP:=false;
 FIsW2k:=false;
 FIsWNT:=false;
 if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
 begin
   FIsWNT:=true;
   if (OSVersionInfo.dwMajorVersion = 5) and (OSVersionInfo.dwMinorVersion = 0) then FIsW2k:=true;
   if (OSVersionInfo.dwMajorVersion = 5) and (OSVersionInfo.dwMinorVersion = 1) then FIsWXP:=true;
 end;
// +jt

  {moved to initialization section
  if not(csDesigning in ComponentState) then
    InitControls
  else
    exit;
  }
  if FActive then
     Self.Active := FActive;

  //if FForm.Handle <> 0 then
  //  Windows.DrawMenuBar(FForm.Handle);
end;

destructor TUCXPStyle.Destroy;
begin
  if Assigned(FForm) then    //oleg [e-mail]  Mon Oct  7
    InitItems(FForm, false, false);

// Remove XPStyle from UCXPStyleManager
  if Assigned(UCXPStyleManager) and not(csDesigning in ComponentState) then
  begin
    UCXPStyleManager.Delete(Self);
    FForm.Update;
    {moved to finalization section
    if UCXPStyleManager.FXPStyleList.Count = 0 then
      DoneControls;
    }
  end;

  //FFont.Free; moved to TCXPSettings
  FreeAndNil(FUCXPSettings); {added by fduenas}
  inherited Destroy;
end;

//add by:
//liyang <[e-mail]> ,2002-07-19
//Pedro Miguel Cunha <[e-mail]>- 02 Apr 2002
procedure TUCXPStyle.Loaded;
begin
  inherited Loaded;

// Add the XPStyle to the UCXPStyleManager
  if Assigned(UCXPStyleManager) and not(csDesigning in ComponentState) then
    UCXPStyleManager.Add(Self);
end;

{to check for new sub items}
procedure TUCXPStyle.ActivateMenuItem(MenuItem: TMenuItem; SubMenus: boolean); // +jt

  procedure Activate(MenuItem: TMenuItem);
  begin
    if (MenuItem.Tag <> 999) then
    if addr(MenuItem.OnDrawItem) <> addr(TUCXPStyle.DrawItem) then
    begin
      if (not assigned(MenuItem.OnDrawItem)) or (FUCXPSettings.OverrideOwnerDraw) then
        MenuItem.OnDrawItem := DrawItem;
      if (not assigned(MenuItem.OnMeasureItem)) or (FUCXPSettings.OverrideOwnerDraw) then
        MenuItem.OnMeasureItem := MeasureItem;
    end
  end;

var
  i{, j}: integer;
begin

  Activate(MenuItem);
  if (SubMenus=true) then // +jt
  begin
   for i := 0 to MenuItem.Count -1 do
   begin
     ActivateMenuItem(MenuItem.Items[i],true);
   end;
 end;
end;

procedure TUCXPStyle.InitItems(wForm: TWinControl; Enable, Update: boolean );
var
  i: integer;
  Comp: TComponent;
begin
  for i := 0 to wForm.ComponentCount - 1 do
  begin
    Comp := wForm.Components[i];
    InitItem(Comp, Enable, Update); // Tom: "Thomas Knoblauch" <[e-mail]> 27.08
  end;
end;

procedure TUCXPStyle.InitComponent(Comp: TComponent); // Tom: for external (by the main program) use without parameters. "Thomas Knoblauch" <[e-mail]> 27.08
begin
  if FActive then InitItem(Comp, true, true);
end;



// Tom: "Thomas Knoblauch" <[e-mail]> 27.08
procedure TUCXPStyle.InitItem(Comp: TComponent; Enable, Update: boolean );
  procedure Activate(MenuItem: TMenuItem);
  begin
    if Enable then
    begin
      if (MenuItem.Tag <> 999) then
      begin
        if (not assigned(MenuItem.OnDrawItem)) or (FUCXPSettings.OverrideOwnerDraw) then
          MenuItem.OnDrawItem := DrawItem;
        if (not assigned(MenuItem.OnMeasureItem)) or (FUCXPSettings.OverrideOwnerDraw) then
          MenuItem.OnMeasureItem := MeasureItem;
      end;
    end
    else
    begin
      if addr(MenuItem.OnDrawItem) = addr(TUCXPStyle.DrawItem) then
        MenuItem.OnDrawItem := nil;
      if addr(MenuItem.OnMeasureItem) = addr(TUCXPStyle.MeasureItem) then
        MenuItem.OnMeasureItem := nil;
    end;
  end;

  procedure ItrateMenu(MenuItem: TMenuItem);
  var
    i: integer;
  begin
    Activate(MenuItem);
    for i := 0 to MenuItem.Count - 1 do
    begin
      ItrateMenu(MenuItem.Items[i]);
    end;
  end;

var
  x: integer;
  s: string;

begin
  if (Comp is TMainMenu) and (xcMainMenu in FUCXPSettings.XPControls) and (TMainMenu(Comp).Tag <> 999)then
  begin
    for x := 0 to TMainMenu(Comp).Items.Count - 1 do
    begin
      TMainMenu(Comp).OwnerDraw := Enable;
      //Activate(TMainMenu(Comp).Items[x]);
      ItrateMenu(TMainMenu(Comp).Items[x]);
    end;
   // Selly way to force top menu in other forms to repaint
    S := TMainMenu(Comp).Items[0].Caption;
    TMainMenu(Comp).Items[0].Caption := '';
    TMainMenu(Comp).Items[0].Caption := S;
  end;

  if (Comp is TPopupMenu) and (xcPopupMenu in FUCXPSettings.XPControls) then
  begin
    for x := 0 to TPopupMenu(Comp).Items.Count - 1 do
    begin
      TPopupMenu(Comp).OwnerDraw := Enable;
      ItrateMenu(TPopupMenu(Comp).Items[x]);

    end;
  end;

  {$IFDEF VER5U}
  if (Comp is TToolBar) and (xcToolBar in FUCXPSettings.XPControls) then
    if not (csDesigning in ComponentState) then
    begin
      if not TToolBar(Comp).Flat then
        TToolBar(Comp).Flat := true;

      if Enable then
      begin
        for x := 0 to TToolBar(Comp).ButtonCount - 1 do
          if (not assigned(TToolBar(Comp).OnCustomDrawButton))
            or (FUCXPSettings.OverrideOwnerDraw) then
          begin
            TToolBar(Comp).OnCustomDrawButton :=
              ToolBarDrawButton;

          end;
      end
      else
      begin
        if addr(TToolBar(Comp).OnCustomDrawButton) =
          addr(TUCXPStyle.ToolBarDrawButton) then
        TToolBar(Comp).OnCustomDrawButton := nil;
      end;
      if Update then
        TToolBar(Comp).Invalidate;
    end;
  {$ENDIF}

  if (Comp is TControlBar) and (xcControlBar in FUCXPSettings.XPControls) then
    if not (csDesigning in ComponentState) then
    begin
      if Enable then
      begin
        if (not assigned(TControlBar(Comp).OnBandPaint))
          or (FUCXPSettings.OverrideOwnerDraw) then
        begin
          TControlBar(Comp).OnBandPaint := ControlBarPaint;
        end;
      end
      else
      begin
        if addr(TControlBar(Comp).OnBandPaint) =
          addr(TUCXPStyle.ControlBarPaint) then
        TControlBar(Comp).OnBandPaint := nil;
      end;
      if Update then
        TControlBar(Comp).Invalidate;
    end;

  if not (csDesigning in ComponentState) then
    if {$IFDEF VER6U}
       ((Comp is TCustomCombo) and (xcCombo in FUCXPSettings.XPControls)) or
       ((Comp is TCustomLabeledEdit) and (xcEdit in FUCXPSettings.XPControls)) or

       {$ELSE}
       ((Comp is TCustomComboBox) and (xcCombo in FUCXPSettings.XPControls)) or
       {$ENDIF}
       ((Comp is TEdit) and (xcEdit in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TMaskEdit') and (xcMaskEdit in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TDBEdit') and (xcMaskEdit in FUCXPSettings.XPControls)) or
       ((Comp is TCustomMemo) and (xcMemo in FUCXPSettings.XPControls)) or
       ((Comp is TCustomRichEdit) and (xcRichEdit in FUCXPSettings.XPControls)) or
       ((Comp is TCustomCheckBox) and (xcCheckBox in FUCXPSettings.XPControls)) or
       ((Comp is TRadioButton) and (xcRadioButton in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TBitBtn') and (xcBitBtn in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TButton') and (xcButton in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TUpDown') and (xcUpDown in FUCXPSettings.XPControls)) or
       ((Comp is TSpeedButton) and (xcSpeedButton in FUCXPSettings.XPControls)) or
       ((Comp is TCustomPanel) and (xcPanel in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TDBNavigator') and (xcButton in FUCXPSettings.XPControls)) or
       ((Comp.ClassName = 'TDBLookupComboBox') and (xcButton in FUCXPSettings.XPControls)) or
       ((Comp is TCustomGroupBox) and (xcGroupBox in FUCXPSettings.XPControls)) or
       ((Comp is TCustomListBox) and (xcListBox in FUCXPSettings.XPControls)) or
       ((Comp is TCustomTreeView) and (xcTreeView in FUCXPSettings.XPControls)) or
       ((Comp is TCustomListView) and (xcListView in FUCXPSettings.XPControls)) or
       ((Comp is TProgressBar) and (xcProgressBar in FUCXPSettings.XPControls)) or
       ((Comp is TCustomHotKey) and (xcHotKey in FUCXPSettings.XPControls))
       then
      if ((TControl(Comp).Parent is TToolbar) and (xccToolBar in FUCXPSettings.XPContainers))or
         ((TControl(Comp).Parent is TCoolbar) and (xccCoolbar in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TCustomPanel) and (xccPanel in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TControlbar) and (xccControlbar in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TScrollBox) and (xccScrollBox in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TCustomGroupBox) and (xccGroupBox in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TTabSheet) and (xccTabSheet in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TTabControl) and (xccTabSheet in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent.ClassName = 'TdxTabSheet') and (xccTabSheet in FUCXPSettings.XPContainers)) or //DeveloperExpress
         ((TControl(Comp).Parent is TPageScroller)  and (xccPageScroller in FUCXPSettings.XPContainers)) or
         {$IFDEF VER5U}
         ((TControl(Comp).Parent is TCustomFrame)  and (xccFrame in FUCXPSettings.XPContainers)) or
         {$ENDIF}
         ((TControl(Comp).Parent.ClassName = 'TDBCtrlPanel')  and (xccFrame in FUCXPSettings.XPContainers)) or
         ((TControl(Comp).Parent is TCustomForm) and (xccForm in FUCXPSettings.XPContainers))


         then
      begin
        if (Enable) and (Comp.Tag <> 999) and (TControl(Comp).Parent.Tag <> 999) then
                                    {skip if Control/Control.parent.tag = 999}
          with TControlSubClass.Create(Self)  do
          begin
            Control := TControl(Comp);
            if Addr(Control.WindowProc) <> Addr(TControlSubClass.ControlSubClass) then
            begin
              orgWindowProc := Control.WindowProc;
              Control.WindowProc := ControlSubClass;
            end;
            FXPStyle := self;

            if (Control is TCustomEdit) then
            begin
              FCtl3D := TEdit(Control).Ctl3D;
              FBorderStyle := TRichEdit(Control).BorderStyle;
            end;
            if Control.ClassName = 'TDBLookupComboBox' then
            begin
              FCtl3D := TComboBox(Control).Ctl3D;
            end;
            if (Control is TCustomListBox) then
            begin
              FCtl3D := TListBox(Control).Ctl3D;
              FBorderStyle := TListBox(Control).BorderStyle;
            end;
            if (Control is TCustomListView) then begin
              FCtl3D := TListView(Control).Ctl3D;
              FBorderStyle := TListView(Control).BorderStyle;
            end;
            if (Control is TCustomTreeView) then begin
              FCtl3D := TTreeView(Control).Ctl3D;
              FBorderStyle := TTreeView(Control).BorderStyle;
            end;

          end;

        if Update then
        begin
          TControl(Comp).invalidate    //in TControlSubClass.ControlSubClass
        end;

      end;

  // Recursive call for possible containers.


  // Do recursive call for RadioGroups
  if (((Comp is TCustomRadioGroup)) and (xccGroupBox in FUCXPSettings.XPContainers)) then
    self.InitItems(Comp as TWinControl, Enable, Update);


  if {$IFDEF VER5U}((Comp is TCustomFrame) and (xccFrame in FUCXPSettings.XPContainers))
     or {$ENDIF}(Comp.ClassName = 'TDBNavigator')
   or (Comp is TCustomForm) then  //By Geir Wikran <[e-mail]>
    self.InitItems(Comp as TWinControl, Enable, Update);


end;

procedure TUCXPStyle.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
  Selected: Boolean);
begin
  try  //"Steve Rice" <[e-mail]>
    if FActive then
      MenueDrawItem(Sender, ACanvas, ARect, Selected);
  except
  end;
end;

function TUCXPStyle.GetImageExtent(MenuItem: TMenuItem; FTopMenu: TMenu): TPoint;
var
  HasImgLstBitmap: boolean;
  B: TBitmap;
begin
  B := TBitmap.Create;
  try
    B.Width := 0;
    B.Height := 0;
    Result.x := 0;
    Result.Y := 0;
    HasImgLstBitmap := false;
// +jt
    if Assigned(FTopMenu) then
   begin
     if FTopMenu.Images <> nil then
       if MenuItem.ImageIndex <> -1 then
         HasImgLstBitmap := true;
    end;
    if (MenuItem.Parent.GetParentMenu.Images <> nil)
    {$IFDEF VER5U}
    or (MenuItem.Parent.SubMenuImages <> nil)
    {$ENDIF}
    then
    begin
      if MenuItem.ImageIndex <> -1 then
        HasImgLstBitmap := true
      else
        HasImgLstBitmap := false;
    end;

    if HasImgLstBitmap then
    begin
    {$IFDEF VER5U}
      if MenuItem.Parent.SubMenuImages <> nil then
        MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B)
      else
    {$ENDIF}
        MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B)
    end
    else