怎么实现不通过第三方控件在D7里编译的程序具备XP的风格，如按钮等。

Question

我们知道有些软件在WIN2K里界面是2K的风格，如按钮，在XP里是XP的风格，我想D7编译的软件也应该有些功能。请大家指教！谢谢啦！

Answer 1

自己写麻烦呀
简单的使用{$R WindowsXP.res}只能使程序有默认的WIndows Theme
还是使用XPMenu之类的最简单http://lysoft.7u7.net

Answer 2

在 控件面板的 win32 下有個 XpManifest 控件, 直接放到你的窗體上就可!!

Answer 3

unit XPButton;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, Buttons;typeTShade = recordC: array[0..15] of TColor;end;typeTXPButton = class(TButton)privateFBaseColor: TColor;FCanvas: TCanvas;IsFocused: Boolean;Shade: TShade;procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;procedure DrawItem(const DrawItemStruct: TDrawItemStruct);procedure SetBaseColor(Value: TColor);function LoadShades(BaseColor: TColor): TShade;function ShadeColor(BaseColor: TColor; Offset: Integer): TColor;protectedprocedure CreateParams(var Params: TCreateParams); override;procedure SetButtonStyle(ADefault: Boolean); override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;published//property BaseColor: TColor read FBaseColor write SetBaseColor default $00777777;property OnClick;property OnContextPopup;property OnDragDrop;property OnDragOver;property OnEndDock;property OnEndDrag;property OnEnter;property OnExit;property OnKeyDown;property OnKeyPress;property OnKeyUp;property OnMouseDown;property OnMouseMove;property OnMouseUp;property OnStartDock;property OnStartDrag;end;procedure Register;implementationprocedure Register;beginRegisterComponents('Liren.z', [TXPButton]);end;　constructor TXPButton.Create(AOwner: TComponent);begininherited Create(AOwner);FCanvas := TCanvas.Create;FBaseColor := $00DDB9B9; //$00777777;ControlStyle := ControlStyle - [csDoubleClicks];Width := 85;Height := 30;Shade := LoadShades(FBaseColor);end;　destructor TXPButton.Destroy;begininherited Destroy;FCanvas.Free;end;　procedure TXPButton.CreateParams(var Params: TCreateParams);begininherited CreateParams(Params);with Params do Style := Style or BS_OWNERDRAW;end;　procedure TXPButton.CNDrawItem(var Message: TWMDrawItem);beginDrawItem(Message.DrawItemStruct^);end;　procedure TXPButton.CMFontChanged(var Message: TMessage);begininherited;Invalidate;end;　procedure TXPButton.CMEnabledChanged(var Message: TMessage);begininherited;Invalidate;end;　procedure TXPButton.DrawItem(const DrawItemStruct: TDrawItemStruct);varIsDown, IsDefault: Boolean;Rec, FocusRect: TRect;Flags: Longint;FilCol, BorCol, CapCol, T1, T2, B1, B2: TColor;beginFCanvas.Handle := DrawItemStruct.hDC;Rec := ClientRect;with DrawItemStruct do beginIsDown := itemState and ODS_SELECTED <> 0;IsDefault := itemState and ODS_FOCUS <> 0;end;Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;if IsDown then Flags := Flags or DFCS_PUSHED;if (DrawItemStruct.itemState and ODS_DISABLED <> 0) thenFlags := Flags or DFCS_INACTIVE;FCanvas.Font := Font;if Enabled then beginBorCol := Shade.C[0];if IsDown then beginT1 := Shade.C[4];T2 := Shade.C[5];B1 := Shade.C[7];B2 := Shade.C[8];FilCol := Shade.C[6];CapCol := Shade.C[15];endelse beginT1 := Shade.C[13];T2 := Shade.C[15];B1 := Shade.C[10];B2 := Shade.C[7];FilCol := Shade.C[13];CapCol := Font.Color;endendelse beginBorCol := Shade.C[8];CapCol := Shade.C[8];FilCol := Shade.C[13];end;　with FCanvas do beginPen.Style := psSolid;Brush := Parent.Brush;FillRect(ClientRect);Brush.Color := FilCol;Pen.Color := BorCol;InflateRect(Rec, -3, -3);RoundRect(Rec.Left, Rec.Top, Rec.Right, Rec.Bottom, 3, 3);if Enabled then beginPen.Color := T1;MoveTo(Rec.Left + 1, Rec.Bottom - 3);LineTo(Rec.Left + 1, Rec.Top + 1);MoveTo(Rec.Left + 2, Rec.Top + 1);LineTo(Rec.Right - 2, Rec.Top + 1);Pen.Color := T2;MoveTo(Rec.Left + 2, Rec.Bottom - 4);LineTo(Rec.Left + 2, Rec.Top + 2);LineTo(Rec.Right - 3, Rec.Top + 2);Pen.Color := B1;MoveTo(Rec.Left + 3, Rec.Bottom - 3);LineTo(Rec.Right - 3, Rec.Bottom - 3);LineTo(Rec.Right - 3, Rec.Top + 2);Pen.Color := B2;MoveTo(Rec.Left + 3, Rec.Bottom - 2);LineTo(Rec.Right - 2, Rec.Bottom - 2);MoveTo(Rec.Right - 2, Rec.Bottom - 3);LineTo(Rec.Right - 2, Rec.Top + 2);{ Make pixel-perfect modifications }if IsDown then beginPixels[Rec.Left + 2, Rec.Top + 2] := T1;Pixels[Rec.Left + 3, Rec.Top + 3] := T2;Pixels[Rec.Left + 2, Rec.Bottom - 2] := B1;Pixels[Rec.Right - 2, Rec.Top + 2] := B1;Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;endelse beginPixels[Rec.Left + 1, Rec.Top + 2] := Shade.C[11];Pixels[Rec.Left + 2, Rec.Top + 1] := Shade.C[11];Pixels[Rec.Left + 3, Rec.Top + 3] := T2;Pixels[Rec.Left + 1, Rec.Bottom - 3] := Shade.C[11];Pixels[Rec.Left + 2, Rec.Bottom - 2] := Shade.C[11];Pixels[Rec.Right - 3, Rec.Top + 1] := Shade.C[11];Pixels[Rec.Right - 2, Rec.Top + 2] := Shade.C[11];Pixels[Rec.Right - 4, Rec.Bottom - 4] := B1;Pixels[Rec.Right - 3, Rec.Bottom - 3] := B2;end;end;InflateRect(Rec, -8, -4);Font.Color := CapCol;Rec.Top := Rec.Top - 1;DrawText(Handle, PChar(Caption), Length(Caption), Rec,DT_CENTER or DT_VCENTER or DT_SINGLELINE);if Enabled then beginFocusRect := Rect(6, 6, width - 6, height - 6);if IsFocused thenDrawFocusRect(FocusRect);end;end;FCanvas.Handle := 0;end;　procedure TXPButton.SetButtonStyle(ADefault: Boolean);beginif (ADefault <> IsFocused) then beginIsFocused := ADefault;Invalidate;end;end;procedure TXPButton.SetBaseColor(Value: TColor);beginif (Value <> FBaseColor) then beginFBaseColor := Value;Shade := LoadShades(FBaseColor);Repaint;end;end;function TXPButton.LoadShades(BaseColor: TColor): TShade;varIndex: Integer;beginfor Index := 0 to 7 doResult.C[Index] := ShadeColor(BaseColor, -(7 - Index) * 17);for Index := 8 to 15 doResult.C[Index] := ShadeColor(BaseColor, (Index - 7) * 17);end;function TXPButton.ShadeColor(BaseColor: TColor; Offset: Integer): TColor;varRed, Green, Blue: Integer;beginRed := (BaseColor and $FF) + Offset;Green := ((BaseColor and $FF00) div 256) + Offset;Blue := ((BaseColor and $FF0000) div 65536) + Offset;if (Red > $FF) then Red := $FF;if (Red < $00) then Red := $00;if (Green > $FF) then Green := $FF;

Answer 4

if (Green < $00) then Green := $00;if (Blue > $FF) then Blue := $FF;if (Blue < $00) then Blue := $00;Result := (Blue * 65536) + (Green * 256) + Red;end;end.　　　制作特殊窗体========================================================={*******************************************************}{ }{ ImgForm v1.01 }{ }{ Copyright (c) 2002-1 Liren Zhao BeiJing China }{ }{ HomePage: Http://Stef.533.net/54 }{ Http://Aojianjianghu.126.com }{ Address:Beijing Syntong Tech Delvelop co.,LTD }{ Email:[email protected] }{ }{*******************************************************}unit ImgForm;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls;typeEImgFormError = class(Exception);TImgForm = class(TCustomPanel) //TGraphicControlprivateFPicture:TBitMap;FMoveForm:Boolean;FormHandle:Hwnd;procedure SetPicture(Value: TBitMap);procedure PictureChange(Sender: TObject);protectedprocedure paint;override;procedure MouseMove(Shift: TShiftState; X,Y: Integer);Override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;procedure Execute;procedure HideInTaskBar;publishedproperty Picture: TBitMap read FPicture write SetPicture;property MoveForm:boolean read FMoveForm write FMoveForm ;property PopupMenu;property DragCursor;property DragKind;property DragMode;property OnClick;property OnContextPopup;property OnDblClick;property OnDragDrop;property OnDragOver;property OnEndDock;property OnEndDrag;property OnMouseDown;property OnMouseMove;property OnMouseUp;property OnStartDock;property OnStartDrag;end;procedure Register;implementationprocedure Register;beginRegisterComponents('Liren.z', [TImgForm]);end;{ TImgForm }constructor TImgForm.Create(AOwner: TComponent);begin//记得以后加上，判断Parent是不是窗体，还有就是self的个数只能为一个inherited Create(AOwner);if not (AOwner is TForm) then //raise EImgFormError.Create('Control parent must be a form!')elsewith (AOwner as TForm) do beginAutoSize:=true;BorderStyle:=bsNone;FormHandle:=Handle;end;Align:=alClient;FMoveForm:=true;FPicture :=TBitMap.Create;FPicture.OnChange:=PictureChange;end;destructor TImgForm.Destroy;beginFPicture.Free;inherited Destroy;end;procedure TImgForm.paint;constXorColor = $00FFD8CE;beginwith Canvas do beginif (csDesigning in ComponentState) then beginPen.Style := psDot;Pen.Mode := pmXor;Pen.Color := XorColor;Brush.Style := bsClear;Rectangle(0, 0, ClientWidth, ClientHeight);TextOut(5,5,'ImgForm');moveto(0,0);Lineto(Width,height);moveto(0,Height);Lineto(Width,0);end;if not FPicture.Empty thenDraw(0,0,FPicture);end;// inherited Paint; // 如果控件从TGraphicControl继承，就不要注释这里end;procedure TImgForm.PictureChange(Sender: TObject);beginif not FPicture.Empty then beginAlign:=alNone;Width:=FPicture.Width;Height:=FPicture.Height;endelseAlign:=alClient;end;procedure TImgForm.Execute;varh,w,i,j:integer;tc:Tcolor;hrgn1,hrgn3:HRGN;beginif not FPicture.Empty then begintc:=FPicture.Canvas.Pixels[0,0];h:=FPicture.Canvas.ClipRect.Bottom -FPicture.Canvas.ClipRect.top ;w:=FPicture.Canvas.ClipRect.Right -FPicture.Canvas.ClipRect.left ;hrgn3:=createrectrgn(0,0,w,h);tryfor i:=0 to w-1 dofor j:=0 to h-1 dobeginif FPicture.Canvas.Pixels[i,j]=tc thenbegindeleteobject(hrgn1);hrgn1:=CreateRectRgn(i,j,i+1,j+1);if hrgn1<>0 thenbeginCombineRgn(hrgn3,hrgn3,hrgn1,RGN_DIFF);end;end;end;deleteobject(hrgn1);setwindowrgn(FormHandle,hrgn3,true);except//RaiseException Hereend;end;end;procedure TImgForm.SetPicture(Value: TBitMap);beginFPicture.Assign(Value);Invalidate;end;procedure TImgForm.MouseMove(Shift: TShiftState; X,Y: Integer);begininherited;if FMoveForm then begin

Answer 5

ReleaseCapture;(Parent as TForm).perform(WM_SysCommand, $F012, 0);end;end;procedure TImgForm.HideInTaskBar;varExtendedStyle : Integer;beginExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW);end;　end.　使用图片做按扭的控件========================================={*******************************************************}{ }{ ImgButton v2.01 (Freeware) }{ }{ Copyright (c) 2002-1 Liren Zhao BeiJing China }{ }{ HomePage: Http://Stef.533.net/54 }{ Http://Aojianjianghu.126.com }{ }{ Email:[email protected] }{ }{*******************************************************}unit ImgButton;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;typeTImgButton = class(TGraphicControl)privateFGNormal: TBitmap;FGMouseDown: TBitMap;FGMouseUp: TBitMap;FGDisabled: TBitMap;tmpBitmap: TBitMap;FCaption: String;FShowCaption: Boolean;FModalResult: TModalResult;FFont:TFont;procedure SetGNormal(Value: TBitMap);procedure SetGMouseDown(Value: TBitMap);procedure SetGMouseUp(Value: TBitMap);procedure SetGDisabled(Value: TBitMap);procedure SetCaption(Value:String);procedure Resize(Sender: TObject);procedure SetShowCaption(Value:Boolean);procedure DrawCaption;procedure SetFont(Value:TFont);protectedprocedure paint;override;procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;publishedproperty PictureEnter: TBitMap read FGMouseUp write SetGMouseUp;property PictureDown: TBitMap read FGMouseDown write SetGMouseDown;property PictureNormal: TBitMap read FGNormal write SetGNormal;property PictureDisable: TBitMap read FGDisabled write SetGDisabled;property ModalResult: TModalResult read FModalResult write FModalResult default 0;property Caption: String read FCaption write SetCaption;property ShowCaption:Boolean read FShowCaption write SetShowCaption;property Font:TFont read FFont write SetFont;property Action;property Anchors;property Enabled;property ParentShowHint;property PopupMenu;property ShowHint;property Visible;property OnClick;property OnDblClick;property OnMouseDown;property OnMouseMove;property OnMouseUp;end;procedure Register;implementationprocedure Register;beginRegisterComponents('Liren.z', [TImgButton]);end;{ TImgButton }constructor TImgButton.Create(AOwner: TComponent);begininherited Create(AOwner);Width := 100;Height := 100;FGNormal :=TBitMap.Create;FGMouseDown :=TBitMap.Create;FGMouseUp :=TBitMap.Create;FGDisabled :=TBitMap.Create;tmpBitmap :=TBitMap.Create;OnResize:=Resize;With Canvas.Font do beginCharset:=GB2312_CHARSET;Color:= clWindowText;Height:=-12;Name:='宋体';Pitch:=fpDefault;Size:=9;end;FFont:=Canvas.Font;end;destructor TImgButton.Destroy;beginFGNormal.Free;FGMouseDown.Free;FGMouseUp.Free;FGDisabled.Free;tmpBitMap:=nil;tmpBitmap.Free;inherited Destroy;end;procedure TImgButton.paint;constXorColor = $00FFD8CE;beginwith Canvas do beginif (csDesigning in ComponentState) then beginPen.Style := psDot;Pen.Mode := pmXor;Pen.Color := XorColor;Brush.Style := bsClear;Rectangle(0, 0, ClientWidth, ClientHeight);end;if not Enabled thenif not FGDisabled.Empty thentmpBitmap:= FGDisabledelsetmpBitMap:=FGNormalelsetmpBitMap:=FGNormal;Canvas.StretchDraw(ClientRect, tmpBitmap);DrawCaption;end;end;procedure TImgButton.SetGDisabled(Value: TBitMap);beginFGDisabled.Assign(Value);Invalidate;end;procedure TImgButton.SetGMouseDown(Value: TBitMap);beginFGMouseDown.Assign(Value);Invalidate;end;procedure TImgButton.SetGNormal(Value: TBitMap);beginFGNormal.Assign(Value);tmpBitmap:= FGNormal;Width:=FGNormal.Width;Height:=FGNormal.Height;Repaint;Canvas.StretchDraw(ClientRect, FGNormal);Invalidate;end;procedure TImgButton.SetGMouseUp(Value: TBitMap);beginFGMouseUp.Assign(Value);Invalidate;end;procedure TImgButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);beginif (x>0) and (x<Width) and (y>0) and (y<Height) then beginif button = mbLeft then beginRepaint;Canvas.StretchDraw(ClientRect, FGMouseDown);DrawCaption;end;end;inherited;end;procedure TImgButton.MouseEnter(var Msg: TMessage);beginif Enabled then beginRepaint;Canvas.StretchDraw(ClientRect, FGMouseUp);DrawCaption;end;end;procedure TImgButton.MouseLeave(var Msg: TMessage);beginif Enabled then beginRepaint;Canvas.StretchDraw(ClientRect, FGNormal);DrawCaption;end;end;procedure TImgButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);beginif (x>0) and (x<Width) and (y>0) and (y<Height) then beginif button = mbLeft then beginRepaint;Canvas.StretchDraw(ClientRect, FGMouseUp);DrawCaption;end;end;inherited;end;　procedure TImgButton.Resize(Sender: TObject);beginif not FGNormal.Empty then beginWidth:=FGNormal.Width;Height:=FGNormal.Height;DrawCaption;end;end;procedure TImgButton.SetCaption(Value: String);beginFCaption:=Value;DrawCaption;Invalidate;end;procedure TImgButton.DrawCaption;varx,y:integer;beginif FShowCaption then beginwith Canvas do beginBrush.Style := bsClear;x:=Round((Width-TextWidth(Caption))/2);y:=Round((Height-TextHeight(Caption))/2);TextOut(x,y,Caption);end;end;end;procedure TImgButton.SetShowCaption(Value: Boolean);beginFShowCaption:=Value;Invalidate;end;procedure TImgButton.SetFont(Value: TFont);beginFFont:=Value;Canvas.Font:=Value;Invalidate;end;end.

Answer 6

uses xpmain可在XP下有XP风格，如要在2000、98下必须借助第三方控制，自己写是不容易的。

Answer 7

在D7的帮助索引里输入 "XP themes"就有相关的说明.
----------------------------------------------
将下面的代码保存为 "你的程序名.exe.manifest"放在你的工程目录里
重新编译一下就可以实现程序在WinXp下按钮等控件自动拥有XP风格啦
----------------------------------------------
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="CompanyName.ProductName.YourApp"
type="win32"
/>
<description>Your application description here.</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>

Answer 8

在D7的win32面板中有一个XPManifest控件，把它用上就可以实现楼主想要的功能了， 和mestars(米豆）说的作用是一样的

Answer 9

谢谢aiirii的指点，谢谢ksaiy给出的学习代码，也谢谢mestars和zhaoyu_me的热心帮助。