ufunction.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

unit uFunction;

interface

uses
  classes,Controls,TB2Item,uSecPlugInf,TBX,SpTBXItem,SpTBXDkPanels,Graphics,
  Windows,SysUtils;

const
  ImageArry1:array[0..41] of string=
  ('M1_101','M1_102','M1_103','M1_104','M1_105','M1_106','M1_107','M1_108',
   'M1_109','M1_110','M1_111','M1_112','M1_113','M1_114','M1_115','M1_116',
   'M1_117','M1_118','M1_119','M1_120','M1_121','M1_122','M1_123','M1_124',
   'M1_125','M1_126','M1_127','M1_128','M1_129','M1_130','M1_131','M1_132',
   'M1_133','M1_134','M1_135','M1_136','M1_137','M1_138','M1_139','M1_140',
   'M1_141','M1_142');

   FaceArray:array[0..24] of string=
   ('FACE_01','FACE_02','FACE_03','FACE_04','FACE_05',
    'FACE_06','FACE_07','FACE_08','FACE_09','FACE_10',
    'FACE_11','FACE_12','FACE_13','FACE_14','FACE_15',
    'FACE_16','FACE_17','FACE_18','FACE_19','FACE_20',
    'FACE_21','FACE_22','FACE_23','FACE_24','FACE_25');

type
  TOnExecute=procedure(sender:TObject) of object;
  TOnAction=procedure(sender:TObject) of object;

function CreateToolBarBtn(BarParent:TSpTBXDock;BarTop,BarLeft:integer;out AOwner:TTBXToolbar;ASecPlug:ISecPlug;DoExecute:TOnExecute):TSpTBXItem;
procedure DeleteToolBarBtn(var AOwner:TTBXToolbar;ABtnName:string);
function CreateToolPopupMenuItem(PopupMenu:TTBXPopupMenu;ASecPlug:ISecPlug;DoAction:TOnAction;DoDrawMenuItem:TSpTBXDrawItemEvent):TSpTBXItem;
procedure DeleteToolPopupMenuItem(PopupMenu:TTBXPopupMenu;AName:string);

procedure AddImages(Img:TImageList;ImageArray:array of string);
function GetBmp(ID:string):Hbitmap;
function GetCur(ID:string):HCURSOR;

procedure DrawMenuItem(MenuItemName:String;PlugList:TInterfaceList;ACanvas: TCanvas;ARect: TRect);

implementation

function CreateToolBarBtn(BarParent:TSpTBXDock;BarTop,BarLeft:integer;out AOwner:TTBXToolbar;ASecPlug:ISecPlug;DoExecute:TOnExecute):TSpTBXItem;
  function CreateToolBar: TTBXToolbar;
  begin
    result:=TTBXToolbar.Create(BarParent);
    result.Parent:=BarParent;
    result.DockPos:=BarLeft;
    result.DockRow:=BarTop;
    result.Options:=result.Options+[tboShowHint];
    result.ShowHint:=true;
  end;
begin
  BarParent.BeginUpdate;
  if AOwner=nil then
    AOwner:=CreateToolBar;
  AOwner.BeginUpdate;
  try
    result:=TSpTBXItem.Create(AOwner);
    result.Name:=ASecPlug.Name;
    result.Hint:=ASecPlug.Description;
    result.Images:=AsecPlug.PlugImages;
    result.ImageIndex:=0;
    result.OnClick:=DoExecute;
    AOwner.Items.Add(result);  
  finally
    AOwner.EndUpdate;
    BarParent.EndUpdate;
  end;
end;

procedure DeleteToolBarBtn(var AOwner:TTBXToolbar;ABtnName:string);
var
  i:integer;
begin
  if AOwner<>nil then
  begin
    for i:=AOwner.Items.Count-1 downto 0 do
    begin
      if AOwner.Items[i].Name=ABtnName then
      begin
        AOwner.Items[i].Free;
        break;
      end;
    end;
    if AOwner.Items.Count=0 then
    begin
      AOwner.Free;
      AOwner:=nil;
    end;
  end;
end;

function CreateToolPopupMenuItem(PopupMenu:TTBXPopupMenu;ASecPlug:ISecPlug;DoAction:TOnAction;DoDrawMenuItem:TSpTBXDrawItemEvent):TSpTBXItem;
var
  Item:TSpTBXItem;
begin
  if ASecPlug.DisplayInMenu then
  begin
    Item:=TSpTBXItem.Create(PopupMenu);
    Item.Name:=ASecPlug.Name;
    Item.Caption:=ASecPlug.Description;
    Item.OnClick:=DoAction;
    PopupMenu.Items.Add(Item);
    result:=Item;
  end
  else
    result:=nil;

  if ASecPlug.DrawMenu then
  begin
    Item:=TSpTBXItem.Create(PopupMenu);
    Item.Tag:=-1;
    Item.Name:=ASecPlug.Name+'_D';
    Item.OnDrawItem:=DoDrawMenuItem; 
    PopupMenu.Items.Add(Item);
  end;
end;

procedure DeleteToolPopupMenuItem(PopupMenu:TTBXPopupMenu;AName:string);
var
  i:integer;
begin
  if PopupMenu<>nil then
  begin
    for i:=PopupMenu.Items.Count-1 downto 0 do
    begin
      if (PopupMenu.Items[i].Name=AName+'_D') or (PopupMenu.Items[i].Name=AName) then
      begin
        //PopupMenu.Items.Delete(i);
        PopupMenu.Items[i].Free;
      end;
    end;
  end;
end;

procedure AddImages(Img:TImageList;ImageArray:array of string);
var
  DllHandle:THandle;
  ABitmap:Hbitmap;
  i:integer;
  BitMap:Graphics.TBitmap;
begin
  DllHandle:=Loadlibrary('SecShell.dll');
  if DllHandle=0 then
    raise Exception.Create('未能加载SecShell.dll，操作失败。');
  for i:=low(ImageArray) to high(ImageArray) do
  begin
    BitMap:=Graphics.TBitmap.Create;
    ABitmap:=LoadBitmap(DllHandle,Pchar(ImageArray[i]));
    BitMap.Handle:=ABitMap; 
    Img.AddMasked(BitMap,$02808000);
  end;
  FreeLibrary(DllHandle);
end;

function GetBmp(ID:string):Hbitmap;
var
  DllHandle:THandle;
  ABitmap:Hbitmap;
begin
  ABitmap:=0;
  DllHandle:=Loadlibrary('SecShell.dll');
  try
    if DllHandle=0 then
      raise Exception.Create('未能加载SecShell.dll，操作失败。');
    ABitmap:=LoadBitmap(DllHandle,Pchar(ID));
  finally
    FreeLibrary(DllHandle);
    result:=ABitmap;
  end;
end;

function GetCur(ID:string):HCURSOR;
var
  DllHandle:THandle;
  ACURSOR:HCURSOR;
begin
  ACURSOR:=0;
  DllHandle:=Loadlibrary('SecShell.dll');
  try
    if DllHandle=0 then
      raise Exception.Create('未能加载SecShell.dll，操作失败。');
    ACURSOR:=LoadCursor(DllHandle,Pchar(ID));
  finally
    FreeLibrary(DllHandle);
    result:=ACURSOR;
  end;
end;

procedure DrawMenuItem(MenuItemName:String;PlugList:TInterfaceList;ACanvas: TCanvas;ARect: TRect);
var
  i:integer;
begin
  if PlugList<>nil then
  begin
    for i:=0 to PlugList.Count-1 do
    begin
      if MenuItemName=ISecPlug(PlugList[i]).Name+'_D' then
      begin
        ISecPlug(PlugList[i]).DrawMenuItem(ACanvas,ARect);
        break;
      end;
    end;
  end;
end;

end.