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

📄 suidsgn.pas

📁 SUIPack是一款为Delphi和C++Builder开发的所见即所得的界面增强VCL组件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
////////////////////////////////////////////////////////////////////////////////
//
//
//  FileName    :   SUIDsgn.pas
//  Creator     :   Shen Min
//  Date        :   2003-04-07 V1-V3
//                  2003-07-11 V4
//  Comment     :
//
//  Copyright (c) 2002-2006 Sunisoft
//  http://www.sunisoft.com
//  Email: support@sunisoft.com
//
////////////////////////////////////////////////////////////////////////////////

unit SUIDsgn;

interface

{$I SUIPack.inc}

uses Classes, Forms, Controls, TypInfo, Menus, StdCtrls, ComCtrls, ExtCtrls,
{$IFDEF SUIPACK_D6UP}{$WARN UNIT_PLATFORM OFF}{$ENDIF}
     CheckLst, SysUtils, Grids, Dialogs, Mask, FileCtrl, Windows,
{$IFDEF SUIPACK_D6UP}{$WARN UNIT_PLATFORM ON}{$ENDIF}     
     {$IFDEF DB}DBCtrls, DBGrids,{$ENDIF}
{$IFDEF SUIPACK_D5}
    DsgnIntf;
{$ENDIF}
{$IFDEF SUIPACK_D6UP}
    DesignIntf, DesignEditors, DesignMenus;
{$ENDIF}

type
    TsuiPageControlEditor = class(TComponentEditor)
    public
        procedure Edit; override;
        procedure ExecuteVerb(Index:Integer);override;
        function GetVerb(Index:Integer):String;override;
        function GetVerbCount:Integer;override;
{$IFDEF SUIPACK_D5}
        procedure PrepareItem(Index: Integer; const AItem: TMenuItem); override;
{$ENDIF}
{$IFDEF SUIPACK_D6UP}
        procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
{$ENDIF}
    end;

    TsuiTabSheetEditor = class(TComponentEditor)
    public
        procedure Edit; override;
        procedure ExecuteVerb(Index:Integer);override;
        function GetVerb(Index:Integer):String;override;
        function GetVerbCount:Integer;override;
{$IFDEF SUIPACK_D5}
        procedure PrepareItem(Index: Integer; const AItem: TMenuItem); override;
{$ENDIF}
{$IFDEF SUIPACK_D6UP}
        procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
{$ENDIF}
    end;

    TsuiDialogEditor = class(TComponentEditor)
    public
        procedure Edit; override;
    end;

    TsuiThemeManagerEditor = class(TComponentEditor)
    public
        procedure Edit; override;
        procedure ExecuteVerb(Index:Integer);override;
        function GetVerb(Index:Integer):String;override;
        function GetVerbCount:Integer;override;
    end;

    TsuiThemeMgrCompListEditor = class(TPropertyEditor)
    public
        procedure Edit(); override;
        function GetAttributes() : TPropertyAttributes; override;
        function GetValue() : string; override;
    end;

    TsuiConvertor = class(TComponent)
    public
        constructor Create(AOwner: TComponent); override;

    end;

    TsuiUnConvertor = class(TComponent)
    public
        constructor Create(AOwner : TComponent); override;
        
    end;

    TsuiThemeFileEditor = class(TPropertyEditor)
    public
        procedure Edit; override;
        function GetAttributes: TPropertyAttributes; override;
        function GetValue: string; override;
    end;

    TsuiFileThemeEditor = class(TComponentEditor)
    public
        procedure Edit; override;
        procedure ExecuteVerb(Index:Integer);override;
        function GetVerb(Index:Integer):String;override;
        function GetVerbCount:Integer;override;
    end;

    TsuiBuiltInThemeFileEditor = class(TPropertyEditor)
    public
        procedure Edit; override;
        function GetAttributes: TPropertyAttributes; override;
        function GetValue: string; override;
    end;

    TsuiBuiltInFileThemeEditor = class(TsuiFileThemeEditor)
    public
        procedure Edit; override;
    end;


implementation

uses SUIMgr, SUIPageControl, SUIDlg, SUIPublic, SUIThemes, SUIForm, frmConvert,
     SUIPopupMenu, SUIMainMenu, SUIButton, SUIProgressBar, SUIEdit, SUIMemo,
     SUIListBox, SUIComboBox, SUIColorBox, SUICheckListBox, SUIGroupBox,
     SUIRadioGroup, SUIListView, SUITreeView, SUITabControl, SUITrackBar,
     SUIScrollBar, SUIStatusBar, {$IFDEF DB}SUIDBCtrls,{$ENDIF} SUIGrid;

// --------- Convertor -----------------------
type
{$IFDEF SUIPACK_D6UP}
    IsuiDesigner = type IDesigner;
{$ENDIF}
{$IFDEF SUIPACK_D5}
    IsuiDesigner = type IFormDesigner;
{$ENDIF}

var
    l_ToRemoveList : TList = nil;

procedure RemoveOldControl(Ctrl : TComponent; DoNow : Boolean = false);
var
    i : Integer;
begin
    if DoNow then
    begin
        if l_ToRemoveList = nil then
            Exit;
        for i := 0 to l_ToRemoveList.Count - 1 do
        begin
            if l_ToRemoveList[i] = nil then
                continue;
            TComponent(l_ToRemoveList[i]).Free();
            l_ToRemoveList[i] := nil;
        end;

        l_ToRemoveList.Free();
        l_ToRemoveList := nil;
    end
    else
    begin
        if l_ToRemoveList = nil then
            l_ToRemoveList := TList.Create();
        l_ToRemoveList.Add(Ctrl);
    end;
end;

procedure AssignProps(NewCtrl, OldCtrl : TComponent; Dsgn : IsuiDesigner);
    function SUIGetPropList(TypeInfo: PTypeInfo; out PropList: PPropList): Integer; overload;
    begin
      Result := GetTypeData(TypeInfo)^.PropCount;
      if Result > 0 then
      begin
        GetMem(PropList, Result * SizeOf(Pointer));
        GetPropInfos(TypeInfo, PropList);
      end;
    end;

    function SUIGetPropList(AObject: TObject; out PropList: PPropList): Integer; overload;
    begin
      Result := SUIGetPropList(PTypeInfo(AObject.ClassInfo), PropList);
    end;

var
    PropList : PPropList;
    nCount : Integer;
    i : Integer;
    PropInfo: PPropInfo;
    PopupMenu : TPopupMenu;
    {$IFDEF SUIPACK_D5}
    TempObj : TObject;
    {$ENDIF}
begin
    nCount := SUIGetPropList(OldCtrl, PropList);
    try
        for i := 0 to nCount - 1 do
        begin
            PropInfo := PropList^[I];

            if PropInfo^.Name = 'Name' then
                continue;

            if PropInfo^.Name = 'Top' then
                continue;

            if (
                (PropInfo^.Name = 'Items') and
                (OldCtrl is TMenu)
            ) then
                continue;

            if not IsHasProperty(NewCtrl, PropInfo^.Name) then
                continue;

            if PropInfo^.Name = 'PopupMenu' then
            begin
                PopupMenu := GetObjectProp(OldCtrl, 'PopupMenu') as TPopupMenu;
                if PopupMenu <> nil then
                begin
                    if Copy(PopupMenu.Name, 1, 7) = 'suitemp' then
                    begin
                        SetObjectProp(NewCtrl, 'PopupMenu', Dsgn.GetComponent(Copy(PopupMenu.Name, 8, Length(PopupMenu.Name))));
                        Continue;
                    end;
                end;
            end;

            case PropInfo^.PropType^.Kind of

            tkInteger, tkChar, tkWChar, tkEnumeration :
            begin
                try
                    SetOrdProp(NewCtrl, PropInfo^.Name, GetOrdProp(OldCtrl, PropInfo^.Name));
                except
                end;
            end;

            tkFloat :
            begin
                try
                    SetFloatProp(NewCtrl, PropInfo^.Name, GetFloatProp(OldCtrl, PropInfo^.Name));
                except
                end;
            end;

            tkString :
            begin
                try
                    SetStrProp(NewCtrl, PropInfo^.Name, GetStrProp(OldCtrl, PropInfo^.Name));
                except
                end;
            end;

            tkSet :
            begin
                {$IFDEF SUIPACK_D6UP}
                try
                    SetSetProp(NewCtrl, PropInfo^.Name, GetSetProp(OldCtrl, PropInfo^.Name));
                except
                end;
                {$ENDIF}
            end;

            tkMethod :
            begin
                try
                    SetMethodProp(NewCtrl, PropInfo^.Name, GetMethodProp(OldCtrl, PropInfo^.Name));
                except
                end;
            end;

            tkClass :
            begin
                {$IFDEF SUIPACK_D6UP}
                try
                    SetObjectProp(NewCtrl, PropInfo^.Name, GetObjectProp(OldCtrl, PropInfo^.Name));
                except
                end;
                {$ENDIF}
                {$IFDEF SUIPACK_D5}
                try
                    TempObj := GetObjectProp(OldCtrl, PropInfo^.Name);
                    if TempObj is TStrings then
                        SetObjectProp(NewCtrl, PropInfo^.Name, TempObj);
                except
                end;
                {$ENDIF}
            end;

            else
            begin
                try
                    if PropInfo^.Name = 'Caption' then
                        SetStrProp(NewCtrl, PropInfo^.Name, GetStrProp(OldCtrl, PropInfo^.Name));
                except
                end;
            end;

            end; //case
        end;
    finally
        FreeMem(PropList);
    end;
end;

Procedure ConvertControls(var Ctrl : TControl; Cls : TControlClass; UIStyle : String; IncHeight : Integer; Dsgn : IsuiDesigner);
var
    NewCtrl : TControl;
    TempName : String;
    TempName2 : String;
    Form : TCustomForm;
begin
    try
        NewCtrl := Dsgn.CreateComponent(Cls, Ctrl.Parent, Ctrl.Left, Ctrl.Top + IncHeight, Ctrl.Width, Ctrl.Height) as TControl;
    except
        Form := GetParentForm(Ctrl);
        NewCtrl := Dsgn.CreateComponent(Cls, Form, Ctrl.Left, Ctrl.Top + IncHeight, Ctrl.Width, Ctrl.Height) as TControl;
        NewCtrl.Parent := Ctrl.Parent;
        NewCtrl.SetBounds(Ctrl.Left, Ctrl.Top, Ctrl.Width, Ctrl.Height);
    end;

    AssignProps(NewCtrl, Ctrl, Dsgn);
    if IsHasProperty(NewCtrl, 'UIStyle') then
        SetEnumProp(NewCtrl, 'UIStyle', UIStyle);
    TempName := Ctrl.Name;
    TempName2 := 'suitemp' + TempName;
    if Dsgn.GetComponent(TempName2) <> nil then
        TempName2 := TempName2 + '1';
    Ctrl.Name := TempName2;
    NewCtrl.Name := TempName;

    if NewCtrl is TsuiScrollBar then
        (NewCtrl as TsuiScrollBar).LargeChange := 2;
    if NewCtrl is TsuiTabSheet then
    begin
        (NewCtrl as TsuiTabSheet).PageIndex := (NewCtrl as TsuiTabSheet).PageControl.PageCount - 1;
    end;
    RemoveOldControl(Ctrl);
    Ctrl := NewCtrl;    
end;

type
    TMenuClass = class of TMenu;

Procedure ConvertMenus(Comp : TMenu; Cls : TMenuClass; UIStyle : String; Dsgn : IsuiDesigner);
var
    NewMenu : TMenu;
    TempName : String;
    TempName2 : String;
    i : Integer;
    MenuItem : TMenuItem;
begin
    NewMenu := Dsgn.CreateComponent(Cls, Comp.Owner, 0, 0, 0, 0) as TMenu;
    AssignProps(NewMenu, Comp, Dsgn);
    SetEnumProp(NewMenu, 'UIStyle', UIStyle);
    TempName := Comp.Name;
    TempName2 := 'suitemp' + TempName;
    if Dsgn.GetComponent(TempName2) <> nil then

⌨️ 快捷键说明

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