unit1.pas

在WINDOWS98或WINDOWS2000上显示出WINDOWS XP上的风格样式的程序窗体 7.02带全部源码。

end;

procedure TForm1.TBXItem26Click(Sender: TObject);
begin
  Tile;
end;

procedure TForm1.TBXItem27Click(Sender: TObject);
begin
  TTBXItem(Sender).Checked := True;
end;

type
  TTBViewAccess = class(TTBView);

procedure TForm1.mnUndoItemsPopup(Sender: TTBCustomItem; FromLink: Boolean);
begin
  UndoList.ItemIndex := 0;
end;

procedure TForm1.UndoListChange(Sender: TObject);
const
  Actns: array [Boolean] of string = (' Action', ' Actions');
begin
  with UndoList do
    UndoLabel.UpdateCaption('Undo ' + IntToStr(ItemIndex + 1) + Actns[ItemIndex <> 0]);
end;

procedure TForm1.lstFontsMeasureHeight(Sender: TTBXCustomList;
  ACanvas: TCanvas; var AHeight: Integer);
begin
  AHeight := AHeight * 3 div 2;
end;

procedure TForm1.lstFontsDrawItem(Sender: TTBXCustomList; ACanvas: TCanvas;
  ARect: TRect; AIndex, AHoverIndex: Integer; var DrawDefault: Boolean);
var
  S: string;
begin
  S := lstFonts.Strings[AIndex];
  ACanvas.Font.Size := 12;
  ACanvas.Font.Name := S;
end;

procedure TForm1.TBXItem60Click(Sender: TObject);
begin
  DockablePanel.Visible := True;
end;

procedure TForm1.MoreColorsClick(Sender: TObject);
begin
  with ColorDialog do
  begin
    Color := ColorPalette.Color;
    if Execute then ColorPalette.Color := Color;
  end;
end;

procedure TForm1.ColorPaletteChange(Sender: TObject);
begin
  ClrDefault.Checked := ColorPalette.Color = clNone;
  ColorCombo.Text := ColorPalette.ColorToString(ColorPalette.Color);
  bColorItem.Color := ColorPalette.Color;
  bColorItem.Caption := 'Current Color: ' + ColorPalette.ColorToString(ColorPalette.Color);
  bColorButton.Invalidate;
end;

procedure TForm1.ClrDefaultClick(Sender: TObject);
begin
  ColorPalette.Color := clNone;
  ClrDefault.Checked := True;
end;

procedure TForm1.TBXRadioButton1Change(Sender: TObject);
begin
  TBXSwitcher.FlatMenuStyle := fmsAuto;
end;

procedure TForm1.TBXRadioButton2Change(Sender: TObject);
begin
  TBXSwitcher.FlatMenuStyle := fmsEnable;
end;

procedure TForm1.TBXRadioButton3Change(Sender: TObject);
begin
  TBXSwitcher.FlatMenuStyle := fmsDisable;
end;

procedure TForm1.TBXCheckBox1Change(Sender: TObject);
begin
  TBXSwitcher.EnableXPStyles := TBXCheckBox1.Checked;
end;

procedure TForm1.TBXStatusBarPanelClick(Sender: TTBXCustomStatusBar; Panel: TTBXStatusPanel);
begin
  if Panel.Index in [2, 4] then Panel.Enabled := not Panel.Enabled;
end;

procedure TForm1.bColorButtonDrawImage(Item: TTBCustomItem;
  Viewer: TTBItemViewer; Canvas: TCanvas; ImageRect: TRect;
  ImageOffset: TPoint; StateFlags: Integer);
var
  Color: TColor;
begin
  if not Boolean(StateFlags and ISF_DISABLED) then
  begin
    Color := ColorPalette.Color;
    OffsetRect(ImageRect, ImageOffset.X, ImageOffset.Y);
    ImageRect.Top := ImageRect.Bottom - 4;
    if Color <> clNone then
    begin
      Canvas.Brush.Color := Color;
      Canvas.FillRect(ImageRect);
    end
    else
    begin
      FrameRectEx(Canvas.Handle, ImageRect, clBtnShadow, True);
      DitherRect(Canvas.Handle, ImageRect, clBtnFace, clBtnShadow);
    end;
  end;
end;

procedure TForm1.TBXSpinEditItem1TextToValue(Sender: TTBXCustomSpinEditItem; const AText: String;
  out AValue: Extended; var CanConvert: Boolean);
begin
  if CompareText(AText, 'Auto') = 0 then
  begin
    AValue := 0;
    CanConvert := True;
  end
  else if CompareText(AText, 'pi') = 0 then
  begin
    AValue := 3.14;
    CanConvert := True;
  end;
end;

procedure TForm1.TBXSpinEditItem1ValueToText(
  Sender: TTBXCustomSpinEditItem; const AValue: Extended;
  var Text: String);
begin
  if AValue <= 0 then Text := 'Auto';
end;

procedure TForm1.TBXSpinEditItem1Convert(Sender: TTBXCustomSpinEditItem;
  const APrefix, APostfix: String; var AValue: Extended;
  var CanConvert: Boolean);
var
  S: string;
begin
  S := APostfix;

  { use current units if user did not type in units explicitly }
  if Length(S) = 0 then S := Sender.Postfix;

  { convert everything to mm }
  if CompareText(S, 'in') = 0 then AValue := AValue * 25.4
  else if CompareText(S, 'cm') = 0 then AValue := AValue * 10;

  { convert mm to current units }
  if CompareText(Sender.Postfix, 'in') = 0 then AValue := AValue / 25.4
  else if CompareText(Sender.Postfix, 'cm') = 0 then AValue := AValue * 0.1;
end;

procedure TForm1.TBXComboList3Change(Sender: TObject; const Text: String);
begin
  TBXSpinEditItem1.Postfix := Text;
end;

procedure TForm1.TBXRadioButton4Click(Sender: TObject);
begin
  TBXDockablePanel1.CaptionRotation := TDPCaptionRotation((Sender as TComponent).Tag);
end;

procedure TForm1.TBXCheckBox3Change(Sender: TObject);
var
  B: Boolean;
begin
  B := (Sender as TTBXCheckBox).Checked;
  DockablePanel.SmoothDrag := B;
  TBXDockablePanel1.SmoothDrag := B;
  TBXDockablePanel2.SmoothDrag := B;
  TBXDockablePanel3.SmoothDrag := B;
end;

procedure TForm1.TBXCheckBox4Change(Sender: TObject);
var
  B: Boolean;
begin
  B := (Sender as TTBXCheckBox).Checked;
  DockablePanel.SmoothDockedResize := B;
  TBXDockablePanel1.SmoothDockedResize := B;
  TBXDockablePanel2.SmoothDockedResize := B;
  TBXDockablePanel3.SmoothDockedResize := B;
end;

function MyInitXPThemes: boolean;
begin
  Result := true;
end;

procedure MyFreeXPThemes;
begin
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  A: boolean;
begin
{  TBXUxThemes.OpenThemeData := uxtheme.OpenThemeData;
  TBXUxThemes.CloseThemeData := uxtheme.CloseThemeData;
  TBXUxThemes.DrawThemeBackground := uxtheme.DrawThemeBackground;
  TBXUxThemes.DrawThemeText := uxtheme.DrawThemeText;
  TBXUxThemes.GetThemeBackgroundContentRect := uxtheme.GetThemeBackgroundContentRect;
  @TBXUxThemes.GetThemeBackgroundExtent := @uxtheme.GetThemeBackgroundContentRect;
  @TBXUxThemes.GetThemePartSize := @uxtheme.GetThemePartSize;
  TBXUxThemes.GetThemeTextExtent := uxtheme.GetThemeTextExtent;
  TBXUxThemes.GetThemeTextMetrics := uxtheme.GetThemeTextMetrics;
  TBXUxThemes.GetThemeBackgroundRegion := uxtheme.GetThemeBackgroundRegion;
  TBXUxThemes.HitTestThemeBackground := uxtheme.HitTestThemeBackground;
  TBXUxThemes.DrawThemeEdge := uxtheme.DrawThemeEdge;
  TBXUxThemes.DrawThemeIcon := uxtheme.DrawThemeIcon;
  TBXUxThemes.IsThemePartDefined := uxtheme.IsThemePartDefined;
  TBXUxThemes.IsThemeBackgroundPartiallyTransparent := uxtheme.IsThemeBackgroundPartiallyTransparent;
  TBXUxThemes.GetThemeColor := uxtheme.GetThemeColor;
  TBXUxThemes.GetThemeMetric := uxtheme.GetThemeMetric;
  TBXUxThemes.GetThemeString := uxtheme.GetThemeString;
  TBXUxThemes.GetThemeBool := uxtheme.GetThemeBool;
  TBXUxThemes.GetThemeInt := uxtheme.GetThemeInt;
  TBXUxThemes.GetThemeEnumValue := uxtheme.GetThemeEnumValue;
  TBXUxThemes.GetThemePosition := uxtheme.GetThemePosition;
  TBXUxThemes.GetThemeFont := uxtheme.GetThemeFont;
  TBXUxThemes.GetThemeRect := uxtheme.GetThemeRect;
  @TBXUxThemes.GetThemeMargins := @uxtheme.GetThemeMargins;
  @TBXUxThemes.GetThemeIntList := @uxtheme.GetThemeIntList;
  @TBXUxThemes.GetThemePropertyOrigin := @uxtheme.GetThemePropertyOrigin;
  @TBXUxThemes.SetWindowTheme := @uxtheme.SetWindowTheme;
  TBXUxThemes.GetThemeFilename := uxtheme.GetThemeFilename;
  TBXUxThemes.GetThemeSysColor := uxtheme.GetThemeSysColor;
  TBXUxThemes.GetThemeSysColorBrush := uxtheme.GetThemeSysColorBrush;
  TBXUxThemes.GetThemeSysBool := uxtheme.GetThemeSysBool;
  TBXUxThemes.GetThemeSysSize := uxtheme.GetThemeSysSize;
  TBXUxThemes.GetThemeSysFont := uxtheme.GetThemeSysFont;
  TBXUxThemes.GetThemeSysString := uxtheme.GetThemeSysString;
  TBXUxThemes.GetThemeSysInt := uxtheme.GetThemeSysInt;
  @TBXUxThemes.IsThemeActive := @uxtheme.IsThemeActive;
  @TBXUxThemes.IsAppThemed := @uxtheme.IsAppThemed;
  TBXUxThemes.GetWindowTheme := uxtheme.GetWindowTheme;
  TBXUxThemes.EnableThemeDialogTexture := uxtheme.EnableThemeDialogTexture;
  TBXUxThemes.IsThemeDialogTextureEnabled := uxtheme.IsThemeDialogTextureEnabled;
  TBXUxThemes.GetThemeAppProperties := uxtheme.GetThemeAppProperties;
  TBXUxThemes.SetThemeAppProperties := uxtheme.SetThemeAppProperties;
  TBXUxThemes.GetCurrentThemeName := uxtheme.GetCurrentThemeName;
  TBXUxThemes.GetThemeDocumentationProperty := uxtheme.GetThemeDocumentationProperty;
  TBXUxThemes.DrawThemeParentBackground := uxtheme.DrawThemeParentBackground;
  TBXUxThemes.EnableTheming := uxtheme.EnableTheming;

  InitXPThemes := MyInitXPThemes;
  FreeXPThemes := MyFreeXPThemes;

  UpdateVariables;}

end;

end.