unit1.~pas

一个获取其他程序图标并把该图标直接显示在MEMU上的应用实例

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, shellapi, Menus, ImgList, CommCtrl, SUIPopupMenu, Registry;


type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ImageList1: TImageList;
    suiPopupMenu1: TsuiPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ime_handle: array[1..50] of string;
  sys: integer; //操作系统版本,0为95/98/me,1为2000以上
  MySysPath: PCHAR;
  i, j: integer;
procedure ReadeReg(); //读取系统输入法
procedure geticon(imefile, filename: string);
procedure addmenuitem(Caption: string; index: integer);
function GetOperatingSystem: integer;
const
  KEY_1 = HKEY_LOCAL_MACHINE;
  KEY_2 = HKEY_USERS;
  KEY_3 = 'System\CurrentControlSet\Control\Keyboard Layouts\';
  KEY_4 = '.DEFAULT\keyboard layout\preload';
implementation

{$R *.dfm}

procedure ReadeReg(); //读取系统输入法
var
  sPass, temp: string;
  RegF: TRegistry;
begin
  if sys = 1 then //win2000的处理
  begin
    RegF := TRegistry.Create;
    RegF.RootKey := KEY_2;
    if RegF.OpenKey(KEY_4, false) = true then
    begin
      i := 1;
      while RegF.ValueExists(inttostr(i)) = true do
      begin
        sPass := RegF.readstring(inttostr(i));
        if length(sPass) > 0 then
        begin
          ime_handle[i] := sPass;
        end;
        i := i + 1;
        j := j + 1; //记数
      end;
      RegF.CloseKey;
    end;

    RegF.RootKey := KEY_1;
    for i := 1 to j do
    begin
      temp := ime_handle[i];
      if RegF.OpenKey(KEY_3 + temp, false) = true then
      begin
        if (temp[1] = 'e') or (temp[1] = 'E') then
        begin //中文输入法
          geticon(RegF.readstring('IME File'), RegF.readstring('Layout Text'));
        end
        else
        begin //除中文输入法外的语言
          geticon('AAAA', RegF.readstring('Layout Text'));
        end;
        RegF.CloseKey;
      end;
    end;
    RegF.Free;
  end;
end;

procedure geticon(imefile, filename: string);
var
  imageindex: integer; //图标索引号
  filepath: array[0..254] of char;
  h: hicon;
  iconindex: word;
begin
  if imefile <> 'AAAA' then
  begin
  //得到图标
    strpcopy(filepath, MySysPath + '\' + imefile);
    iconindex := 0;
    h := Extractassociatedicon(hinstance, filepath, iconindex);
    imageindex := ImageList_AddIcon(Form1.ImageList1.Handle, h);
    addmenuitem(filename, imageindex);
  end
  else
  begin
    addmenuitem(filename, 0);
  end;
end;

procedure addmenuitem(Caption: string; index: integer);
var
  PullDown: TMenuItem;
begin
  PullDown := TMenuItem.Create(Form1);
  PullDown.Caption := Caption;
  PullDown.imageindex := index;
  Form1.suiPopupMenu1.Items.Add(PullDown);
end;

{判断是哪类操作系统}
function GetOperatingSystem: integer;
var osVerInfo: TOSVersionInfo;
begin
  osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(osVerInfo) then
    case osVerInfo.dwPlatformId of
      VER_PLATFORM_WIN32_NT:
        begin
          result := 1 //'Windows NT/2000/XP'
        end;
      VER_PLATFORM_WIN32_WINDOWS:
        begin
          result := 0; //'Windows 95/98/98SE/Me';
        end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//得到system路径
  GetMem(MySysPath, 255);
  GetSystemDirectory(MySysPath, 255);
  sys := GetOperatingSystem;
  ReadeReg();
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  suiPopupMenu1.Popup(Form1.Left + 50, Form1.Top + 50);
  suiPopupMenu1.OwnerDraw:=true;
end;

end.