谁有提取程序图标的源码？（我没分了，以后给100）(0分)

什么是大图标、小图标？全部提取！！

2003-3-18？
我是不是眼睛花了？

没有！！

unit UMain;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus, StdCtrls, RxMenus ,VCLUtils,
ImgList, Buttons, RXSplit, ComCtrls,IconTools,i2bconvert,
AdvancedIcon,IconImage, IconLibrary;

const
SS_MOVEWINDOW = WM_USER +1008;

type
TfrmMain = class(TForm)
pnlCaption: TPanel;
imgCaptionLeft: TImage;
imgCaptionRight: TImage;
imgCaptionCenter: TImage;
imgEdgeButtom: TImage;
imgEdgeLeft: TImage;
imgEdgeRight: TImage;
imgMinimize: TImage;
imgSystemButton: TImage;
imgMaximize: TImage;
imgClose: TImage;
imgMinimizeClicked: TImage;
imgMaximizeClicked: TImage;
imgCloseClicked: TImage;
imgSystemButtonClicked: TImage;
lblBackCaption: TLabel;
lblForeCaption: TLabel;
pnlClient: TPanel;
pmMain: TRxPopupMenu;
miOpen: TMenuItem;
miSave: TMenuItem;
miBreak2: TMenuItem;
miExit: TMenuItem;
ilMain: TImageList;
pnlToolBar: TPanel;
imgToolBarLeft: TImage;
imgToolBarRight: TImage;
imgToolbarCenter: TImage;
miBreak5: TMenuItem;
miAbout: TMenuItem;
OpenBtn: TSpeedButton;
SaveBtn: TSpeedButton;
AboutBtn: TSpeedButton;
FileOpen: TOpenDialog;
IcoSaveDialog: TSaveDialog;
StatusBar1: TStatusBar;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
RxSplitter1: TRxSplitter;
QuitBtn: TSpeedButton;
N1: TMenuItem;
N2: TMenuItem;
v1: TMenuItem;
LibSaveDialog: TSaveDialog;
C1: TMenuItem;
ClearBtn: TSpeedButton;
Panel4: TPanel;
RxSplitter2: TRxSplitter;
Panel5: TPanel;
IcoListBox: TListBox;
Image1: TImage;
PopupMenu1: TPopupMenu;
SaveAs1: TMenuItem;
N3: TMenuItem;
MImageList: TImageList;
Panel6: TPanel;
RxSplitter3: TRxSplitter;
Panel7: TPanel;
LibListBox: TListBox;
ListView1: TListView;
Image2: TImage;
procedure FormCreate(Sender: TObject);
procedure imgMinimizeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgMinimizeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgMaximizeMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgMaximizeMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure imgCaptionCenterMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure imgCaptionCenterMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure imgCaptionCenterMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure imgSystemButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure imgSystemButtonMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure imgCaptionCenterDblClick(Sender: TObject);
procedure miExitClick(Sender: TObject);
procedure pmMainDrawMargin(Sender: TMenu; Rect: TRect);
procedure miOpenClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LibListBoxClick(Sender: TObject);
procedure IcoListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure IcoListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure SaveBtnClick(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
procedure v1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure miSaveClick(Sender: TObject);
procedure miAboutClick(Sender: TObject);
procedure AboutBtnClick(Sender: TObject);
procedure QuitBtnClick(Sender: TObject);
procedure SaveAs1Click(Sender: TObject);
procedure N3Click(Sender: TObject);

private
TransColor : TColor;
IsClickCaption :bool;
OldPos,NewPos : TPoint;
procedure AdjustSystemButton(ALeft,ATop : integer);
procedure WriteRotaePlus(Canvas: TCanvas; X, Y: Integer; Text: String;
Angle: Integer);
procedure WMNcHitTest(var Msg : TMessage);message WM_NCHITTEST;
{ Private declarations }
public
Icon : TAdvancedIcon;
IconLib : TIconLibrary;
P : Pointer;
procedure LibraryLoaded;
procedure IconLoaded;
procedure LIBIconSelected;
procedure ApplyChanges;
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

{ TfrmMain }

//==============================================================================
// Interface
// 程序界面
//==============================================================================
procedure TfrmMain.AdjustSystemButton(ALeft, ATop: integer);
begin
imgMinimize.Left := ALeft + 14;
imgMinimizeClicked.Left := ALeft + 14;
imgMaximize.Left := imgMinimize.Left + 12;
imgMaximizeClicked.Left := imgMinimize.Left +12;
imgClose.Left := imgMinimize.Left + 26;
imgCloseClicked.Left := imgMinimize.Left + 26;
end;

procedure TfrmMain.WriteRotaePlus(Canvas: TCanvas; X, Y: Integer;
Text: String; Angle: Integer);
var
lf : TLogFont;
tf : TFont;
begin
with Canvas do begin
tf := TFont.Create;
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := Angle*10;
lf.lfOrientation := Angle*10;
tf.Handle := CreateFontIndirect(lf);
Canvas.TextFlags:=ETO_OPAQUE;
Font.Assign(tf);
tf.Free;
TextOut(X,Y,Text);
end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
Pt : TPoint;
RGN : HRGN;
begin
TransColor := i2bDefaultColor;
IsClickCaption := false;
//***********Create Round Window***************//
Pt := Point(Left,Top);
Pt := ScreenToClient(Pt);
RGN := CreateRoundRectRgn(Pt.x,Pt.y,Pt.x+Width,Pt.y+Height,15,15);
SetWindowRgn(Handle,RGN,true);
//***********End Create Round Window***********//

Icon:=TAdvancedIcon.Create;
IconLib:=TIconLibrary.Create;
end;

procedure TfrmMain.imgMinimizeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
imgMinimize.Visible := false;
imgMinimizeClicked.Visible := true;
end;
end;

procedure TfrmMain.imgMinimizeMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
imgMinimize.Visible := true;
imgMinimizeClicked.Visible := false;
if ((X > 0) and (X < imgMinimize.Width)) and ((Y > 0) and (Y < imgMinimize.Height)) then
Application.Minimize;
end;

procedure TfrmMain.imgMaximizeMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
imgMaximize.Visible := false;
imgMaximizeClicked.Visible := true;
end;
end;

procedure TfrmMain.imgMaximizeMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
imgMaximizeClicked.Visible := false;
imgMaximize.Visible := true;
if ((X > 0) and (X < imgMinimize.Width)) and ((Y > 0) and (Y < imgMinimize.Height)) then
begin
if WindowState = wsMaximized then
begin
WindowState := wsNormal;
imgMaximize.Hint := '最大化';
imgMaximizeClicked.Hint := '最大化';
end
else begin
WindowState := wsMaximized;
imgMaximize.Hint := '恢复';
imgMaximizeClicked.Hint := '恢复';
end;
end;
end;



procedure TfrmMain.imgCloseMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
imgClose.Visible := false;
imgCloseClicked.Visible := true;
end;
end;

procedure TfrmMain.imgCloseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
imgCloseClicked.Visible := false;
imgClose.Visible := true;
if ((X > 0) and (X < imgMinimize.Width)) and ((Y > 0) and (Y < imgMinimize.Height)) then
Close;
end;

procedure TfrmMain.imgCaptionCenterMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
IsClickCaption := true;
OldPos := Point(X,Y);
end;
end;

procedure TfrmMain.imgCaptionCenterMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if IsClickCaption then
begin
NewPos := Point(X,Y);
Top := Top + (NewPos.y - OldPos.y);
Left := Left + (NewPos.x - OldPos.x);
end;
end;

procedure TfrmMain.imgCaptionCenterMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
IsClickCaption := false;
end;

procedure TfrmMain.imgSystemButtonMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
imgSystemButtonClicked.Visible := true;
imgSystemButton.Visible := false;
end;

end;

procedure TfrmMain.imgSystemButtonMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Pt : TPoint;
begin
if Button = mbLeft then
begin
imgSystemButton.Visible := True;
imgSystemButtonClicked.Visible := false;
if ((X > 0) and (X < imgSystemButton.Width)) and ((Y > 0) and (Y < imgSystemButton.Height)) then
begin
Pt := Point(9,26);
Pt := ClientToScreen(Pt);
pmMain.Popup(Pt.X,Pt.Y);
end;
end;
end;

procedure TfrmMain.N1Click(Sender: TObject);
begin
Close;
end;



procedure TfrmMain.FormResize(Sender: TObject);
var
Pt : TPoint;
RGN : HRGN;
begin
if (Height < pnlCaption.Height) or (Width < 150 ) then
begin
Height := pnlCaption.Height+100;
Width := 250;
end;
//***********Create Round Window***************//
Pt := Point(Left,Top);
Pt := ScreenToClient(Pt);
RGN := CreateRoundRectRgn(Pt.x,Pt.y,Pt.x+Width,Pt.y+Height,15,15);
SetWindowRgn(Handle,RGN,true);
//***********End Create Round Window***********//
AdjustSystemButton(imgCaptionRight.Left,ImgCaptionRight.Top);
end;

procedure TfrmMain.imgCaptionCenterDblClick(Sender: TObject);
begin
if WindowState = wsMaximized then
begin
WindowState := wsNormal;
imgMaximize.Hint := '最大化';
imgMaximizeClicked.Hint := '最大化';
end
else begin
WindowState := wsMaximized;
imgMaximize.Hint := '恢复';
imgMaximizeClicked.Hint := '恢复';
end;
end;

procedure TfrmMain.WMNcHitTest(var Msg: TMessage);
const
v=8;
var
Pt:TPoint;
begin
if WindowState = wsMaximized then exit;
Pt := Point(Msg.LParamLo,Msg.LParamHi);
Pt := ScreenToClient(Pt);
if PtInRect(Rect(0,0,v,v),Pt) then
Msg.Result := HTTOPLEFT
else if PtInRect(Rect(Width-v,Height-v,Width,Height),Pt) then
Msg.Result := HTBOTTOMRIGHT
else if PtInRect(Rect(Width-v,0,Width,v),Pt) then
Msg.Result := HTTOPRIGHT
else if PtInRect(Rect(0,Height-v,v,Height),Pt) then
Msg.Result := HTBOTTOMLEFT
else if PtInRect(Rect(v,0,Width-v,v),Pt) then
Msg.Result := HTTOP
else if PtInRect(Rect(0,v,v,Height-v),Pt) then
Msg.Result := HTLEFT
else if PtInRect(Rect(Width-v,v,Width,Height-v),Pt) then
Msg.Result := HTRIGHT
else if PtInRect(Rect(v,Height-v,Width-v,Height),Pt) then
Msg.Result := HTBOTTOM;
if (Height < pnlCaption.Height) or (Width < 150 ) then
begin
Height := pnlCaption.Height+100;
Width := 250;
end;
end;

procedure TfrmMain.miExitClick(Sender: TObject);
begin
Close;
end;

procedure TfrmMain.pmMainDrawMargin(Sender: TMenu; Rect: TRect);
var
i: Integer;
rectangle:TRect;
Heightz: Integer;
begin
Heightz:=0;
for i:=0 to pmMain.Items.Count-1 do
begin
GetMenuItemRect (Handle, pmMain.Handle,i, Rectangle);
Heightz:= Heightz +(Rectangle.Bottom-Rectangle.Top);
end;
GradientFillRect(pmMain.Canvas,Rect,clBlue,$00E6BEBE, fdBottomToTop,255);
pmMain.Canvas.Brush.Style:=(bsClear);
pmMain.Canvas.Font.Name:='宋体';
pmMain.Canvas.Font.Style:=[fsBold];
pmMain.Canvas.Font.Size:=10;
pmMain.Canvas.Font.Color := clInfoBK;
WriteRotaePlus (pmMain.Canvas,1, Heightz-1, 'IConExpert 1.0',90);
end;

//==============================================================================
//Code
//程序代码
//==============================================================================



procedure TfrmMain.miOpenClick(Sender: TObject);
begin
IF NOT FileOpen.Execute Then exit;
IconLib.LoadFromFile(FileOpen.Filename);
LibraryLoaded;
LIBListBox.Enabled:=True;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
Icon.Free;
IconLib.free;
IconLib.Free;
end;

procedure TFrmMain.LibraryLoaded;
begin
LIBListBox.Items.assign(IconLib.Icons);
//LibNameLabel.caption:=' Library: '+IconLib.Filename;
IF LIBListBox.Items.Count>0 Then begin
LIBListBox.ItemIndex:=0;
LibIconSelected;
end;
end;

procedure TFrmMain.IconLoaded;
Var
I,j : Integer;
Image : TIconImage;
HIcon1:HIcon;
BitMap1:TBitMap;
begin
BitMap1:=TBitMap.Create;
ListView1.Items.Clear;
With ICOListBox Do begin
Items.Clear;
Items.BeginUpdate;
try
FOR I:=1 TO Icon.Images.Count DO begin
Image:=Icon.Images.Image[I-1];
Items.AddObject(InttoStr(I),Image);
end;
finally
Items.EndUpdate;
end;
IF Items.Count>0 Then ICOListBox.ItemIndex:=0;
end;

FOR j:=1 TO Icon.Images.Count DO
begin
Image:=Icon.Images.Image[j-1];
HIcon1:=Image.Handle;
Image1.Picture.Icon.Handle:=HIcon1;
ConvertIcon2Bitmap(Image1.Picture.Icon,TransColor,Bitmap1);
Image2.picture.bitmap.Assign(BitMap1);

// iLMain.AddIcon(IconList.Image[j-1]);
// ListView1.Items.Add;
// ListView1.Items.Item[j].imageindex:=i;
end;
BitMap1.Destroy;
end;

procedure TFrmMain.ApplyChanges;
Var
I : TAdvancedIcon;
begin
// IF NOT DoChange.Checked then exit;
With LIBListBox do begin
IF (ItemIndex<0) OR (ItemIndex>=IconLib.Icons.Count) then exit;
I:=TAdvancedIcon(Items.Objects[ItemIndex]);
I.Assign(Icon);
end;
end;

procedure TFrmMain.LIBIconSelected;
Var
I : TAdvancedIcon;
begin
IF LIBListBox.ItemIndex<0 then exit;
I:=TAdvancedIcon(LIBListBox.Items.Objects[LIBListBox.ItemIndex]);
IF NOT Assigned(I) Then exit;
IF NOT (I is TAdvancedIcon) Then exit;
Icon.Assign(I);
IconLoaded;
end;

procedure TfrmMain.LibListBoxClick(Sender: TObject);
begin
LIBIconSelected;
end;

procedure TfrmMain.IcoListBoxMeasureItem(Control: TWinControl;
Index: Integer; var Height: Integer);
Var
Image : TIconImage;
begin
With ICOListBox DO begin
IF Index<0 Then exit;
IF Index>=Icon.Images.Count Then exit;
Image:=Icon.Images.Image[Index];
IF NOT Assigned(Image) then exit;
IF NOT (Image is TIconImage) Then exit;
end;
Height:=Image.Info.Height+4;
end;

procedure TfrmMain.IcoListBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
Var
S : String;
Image : TIconImage;
begin
With ICOListBox DO begin
IF Index<0 Then exit;
IF Index>=Icon.Images.Count Then exit;
Image:=Icon.Images.Image[Index];

// ConvertIcon2Bitmap(Icon1,Bitmap1);
// Image1.picture.bitmap.Assign(BitMap1);
IF NOT Assigned(Image) then exit;
IF NOT (Image is TIconImage) Then exit;
With Canvas DO begin
With Image.Info DO begin
FillRect(Rect);
IF rect.Left=0 Then Image.Draw(Canvas,Rect.Left+((60-Width)DIV 2),Rect.Top+2);
S:=(Control as TListBox).Items[Index];
TextOut(Rect.Left+28, Rect.Top+30+((Height-TextExtent(S).cy) DIV 2),S);
// IF (odSelected in State) Then InvertRect(Canvas.Handle,Classes.Rect(Rect.Left+H+2,Rect.Top,Rect.Right,Rect.Bottom) );
end;
end;
end;
end;

procedure TfrmMain.SaveBtnClick(Sender: TObject);
begin
IF Icon.Images.Count=0 Then exit;
IF NOT ICOSaveDialog.Execute Then exit;
Icon.SaveToFile(ICOSaveDialog.Filename);
end;

procedure TfrmMain.OpenBtnClick(Sender: TObject);
begin
IF NOT FileOpen.Execute Then exit;
IconLib.LoadFromFile(FileOpen.Filename);
LibraryLoaded;
LIBListBox.Enabled:=True;
end;

procedure TfrmMain.v1Click(Sender: TObject);
begin
IF IconLib.Icons.Count=0 Then exit;
IF NOT LIBSaveDialog.Execute Then exit;
IconLib.SaveToFile(LIBSaveDialog.Filename);
end;

procedure TfrmMain.N2Click(Sender: TObject);
begin
With LIBListBox DO begin
IF (ItemIndex<0) OR (ItemIndex>IconLib.Icons.Count) Then exit;
IconLib.Icons.Delete(ItemIndex);
LibraryLoaded;
end;
end;

procedure TfrmMain.C1Click(Sender: TObject);
begin
IconLib.Icons.Clear;
Icon.Images.Clear;
LibraryLoaded;
IconLoaded;
end;

procedure TfrmMain.ClearBtnClick(Sender: TObject);
begin
IconLib.Icons.Clear;
Icon.Images.Clear;
LibraryLoaded;
IconLoaded;
end;

procedure TfrmMain.miSaveClick(Sender: TObject);
begin
IF Icon.Images.Count=0 Then exit;
IF NOT ICOSaveDialog.Execute Then exit;
Icon.SaveToFile(ICOSaveDialog.Filename);
end;

procedure TfrmMain.miAboutClick(Sender: TObject);
begin
MessageBox(Handle,'IconExpert 1.0'+#13+'For Win98,WinME,Win2K'+#13+'CopyLeft SamS Soft'+#13+'Qdshen@263.net','关于',MB_OK or MB_ICONINFORMATION);
end;

procedure TfrmMain.AboutBtnClick(Sender: TObject);
begin
MessageBox(Handle,'IconExpert 1.0'+#13+'For Win98,WinME,Win2K'+#13+'CopyLeft SamS Soft'+#13+'Qdshen@263.net','关于',MB_OK or MB_ICONINFORMATION);
end;

procedure TfrmMain.QuitBtnClick(Sender: TObject);
begin
close;
end;

procedure TfrmMain.SaveAs1Click(Sender: TObject);
begin
IF Icon.Images.Count=0 Then exit;
IF NOT ICOSaveDialog.Execute Then exit;
Icon.SaveToFile(ICOSaveDialog.Filename);
end;

procedure TfrmMain.N3Click(Sender: TObject);
begin
With LIBListBox DO begin
IF (ItemIndex<0) OR (ItemIndex>IconLib.Icons.Count) Then
begin
IcoListBox.Items.Clear;
exit;
end;
IconLib.Icons.Delete(ItemIndex);
LibraryLoaded;
end;
end;

end.

Icon.SaveToFile();
我想把这个写入Dll，供VB调用，请问怎么写？

接受答案了.