main.pas

非常好的xp界面控件

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ComCtrls, xpPages, xpGraphUtil;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    xpPageControl1: TxpPageControl;
    xpTabSheet1: TxpTabSheet;
    xpTabSheet2: TxpTabSheet;
    xpTabSheet3: TxpTabSheet;
    xpTabSheet4: TxpTabSheet;
    Panel5: TPanel;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox2: TGroupBox;
    CheckBox1: TCheckBox;
    Label5: TLabel;
    ComboBox1: TComboBox;
    CheckBox2: TCheckBox;
    ColorDialog1: TColorDialog;
    Button1: TButton;
    CheckBox3: TCheckBox;
    GroupBox3: TGroupBox;
    Label6: TLabel;
    ComboBox2: TComboBox;
    Button2: TButton;
    CheckBox4: TCheckBox;
    Panel6: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    ComboBox3: TComboBox;
    Label16: TLabel;
    Label17: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ExPageControl1DrawItem(Control: TWinControl; Index: Integer;
      ACanvas: TControlCanvas; Rect: TRect; State: TOwnerDrawState);
    procedure Button1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure xpPageControl1DrawItem(Control: TWinControl; Index: Integer;
      ACanvas: TControlCanvas; ARect: TRect; State: TOwnerDrawState);
    procedure CheckBox4Click(Sender: TObject);
    procedure Label14Click(Sender: TObject);
    procedure ComboBox3Change(Sender: TObject);
    procedure xpPageControl1Change(Sender: TObject);
    procedure Label17Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

const
  cTabWidth  : Integer = 120;
  cTabHeight : Integer = 24;

implementation

uses shellAPI;

{$R *.DFM}
{R windowsxp.res}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.ItemIndex := 2;
  ComboBox2.ItemIndex := 3;
  ComboBox3.ItemIndex := 0;
  xpPageControl1.TabWidth := cTabWidth;
  xpPageControl1.TabHeight := cTabHeight;
end;


procedure TForm1.ExPageControl1DrawItem(Control: TWinControl;
  Index: Integer; ACanvas: TControlCanvas; Rect: TRect;
  State: TOwnerDrawState);
begin
  OffsetRect (Rect, -1,0);
  GradientFillRect (ACanvas, Rect, clWhite, clLtGray, fdVerticalFromCenter, 10);
  ACanvas.Brush.Color := clRed;
  ACanvas.FrameRect (Rect);
end;



procedure TForm1.Button1Click(Sender: TObject);
begin
  ColorDialog1.Color := xpPageControl1.BorderColor;
  if ColorDialog1.Execute then
    xpPageControl1.BorderColor := ColorDialog1.Color;
end;

procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  xpPageControl1.TabPosition := tpTop;

  if ComboBox2.ItemIndex = 3 then
  begin
    xpPageControl1.TabWidth := cTabWidth;
    xpPageControl1.TabHeight := cTabHeight;
  end;
end;

procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  xpPageControl1.TabPosition := tpBottom;
  if ComboBox2.ItemIndex = 3 then
  begin
    xpPageControl1.TabWidth := cTabWidth;
    xpPageControl1.TabHeight := cTabHeight;
  end;
end;

procedure TForm1.RadioButton3Click(Sender: TObject);
begin
  xpPageControl1.TabPosition := tpLeft;
  if ComboBox2.ItemIndex = 3 then
  begin
    xpPageControl1.TabWidth := cTabHeight;
    xpPageControl1.TabHeight := cTabWidth;
  end;
end;

procedure TForm1.RadioButton4Click(Sender: TObject);
begin
  xpPageControl1.TabPosition := tpRight;
  if ComboBox2.ItemIndex = 3 then
  begin
    xpPageControl1.TabWidth := cTabHeight;
    xpPageControl1.TabHeight := cTabWidth;
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  xpPageControl1.ShowHint := CheckBox1.Checked;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  xpPageControl1.TabTextAlignment := TAlignment (ComboBox1.ItemIndex);
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  if CheckBox2.Checked then
    xpPageControl1.ImageList := ImageList1
  else
    xpPageControl1.ImageList := nil;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
  xpPageControl1.HotTrack := CheckBox3.Checked;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
begin
  if ComboBox2.ItemIndex in [1, 2] then
  begin
    RadioButton1.Checked := true;
    RadioButton2.Enabled := False;
    RadioButton3.Enabled := False;
    RadioButton4.Enabled := False;
    Label5.Enabled := False;
    ComboBox1.Enabled := False;
    Button1.Enabled := False;
    CheckBox1Click (self);
  end
  else
  begin
    RadioButton2.Enabled := true;
    RadioButton3.Enabled := true;
    RadioButton4.Enabled := true;
    Label5.Enabled := (ComboBox2.ItemIndex = 3);
    ComboBox1.Enabled := (ComboBox2.ItemIndex = 3);
    Button1.Enabled := (ComboBox2.ItemIndex = 3);
  end;

  if ComboBox2.ItemIndex <> 3 then
  begin
    xpPageControl1.TabWidth := 0;
    xpPageControl1.TabHeight := 0;
  end
  else
  begin
    if RadioButton1.Checked or RadioButton2.Checked then
    begin
      xpPageControl1.TabWidth := cTabWidth;
      xpPageControl1.TabHeight := cTabHeight;
    end
    else
    begin
      xpPageControl1.TabWidth := cTabHeight;
      xpPageControl1.TabHeight := cTabWidth;
    end;
  end;

  xpPageControl1.Style := TxpPageControlStyle (ComboBox2.ItemIndex);
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
  ColorDialog1.Color := (xpPageControl1.ActivePage as TxpTabSheet).Color;
  if ColorDialog1.Execute then
    (xpPageControl1.ActivePage as TxpTabSheet).Color := ColorDialog1.Color;
end;



procedure TForm1.xpPageControl1DrawItem(Control: TWinControl;
  Index: Integer; ACanvas: TControlCanvas; ARect: TRect;
  State: TOwnerDrawState);
begin
  InflateRect (ARect, -1, -2);
  if Index = xpPageControl1.ActivePage.TabIndex then InflateRect (ARect, 2, 0);
  Dec (ARect.Top, 1);
  GradientFillRect (ACanvas, ARect, clWhite, clSilver, fdVerticalFromCenter, 30);
  InflateRect (ARect, 1, 1);
  ACanvas.Pen.Color := xpPageControl1.BorderColor;
  ACanvas.Brush.Style := bsCLEAR;
  ACanvas.Rectangle (ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  ACanvas.Font.Color := clNavy;
  ACanvas.Font.Style := [fsBold];
  ACanvas.TextOut (ARect.Left+5, ARect.Top + 4, 'Tab ' + IntToStr (Index+1));
end;

procedure TForm1.CheckBox4Click(Sender: TObject);
begin
  xpPageControl1.OwnerDraw := CheckBox4.Checked;
end;


procedure TForm1.Label14Click(Sender: TObject);
begin
  ShellExecute (Application.Handle, 'open', 'http:\\www.rhoStyle.com', '', '', SW_SHOWNORMAL);
end;

procedure TForm1.ComboBox3Change(Sender: TObject);
begin
  (xpPageControl1.ActivePage as TxpTabSheet).BGStyle :=  TxpTabBGStyle (ComboBox3.ItemIndex);
end;

procedure TForm1.xpPageControl1Change(Sender: TObject);
begin
  ComboBox3.ItemIndex := Integer ((xpPageControl1.ActivePage as TxpTabSheet).BGStyle);
end;


procedure TForm1.Label17Click(Sender: TObject);
begin
  ShellExecute (Handle, 'open', 'mailto:[e-mail]', '', '', SW_SHOWNORMAL);
end;


end.