13

Word 2010 の [オプション] ダイアログは、クリック (選択) するとオレンジ色になる白い「トグル」ボタンのセットを介してカテゴリ セレクターを実装します。

Word 2010 の [オプション] ダイアログでのカテゴリの選択

このような動作を Delphi で再実装するにはどうすればよいでしょうか。現在の Windows テーマに準拠する必要があります (つまり、ボタンの色を clWhite ではなく clWindow として指定できる必要があります)。

編集：明確にするために-左側のカテゴリセレクターにのみ問題があります。他のすべてはかなり単純です。

4

4 に答える 4

8

スタイルを lbOwnerDrawFixed (間隔のサイズが重要でない場合) または lbOwnerDrawVariable (重要な場合) に設定した TListBox を使用できます。

その後、それに応じて OnDrawItem と OnMeasureItem を処理できます。

clWindow を使用しても問題ありませんが、オレンジ色は Windows テーマの一部ではありませんが、clHighlight から始めて色相シフトを適用し、シェーディングに明度シフトを適用することで、テーマに一致するものを取得できます。

色相シフトが一定の場合、テーマの色に自動的に適応します。

サンプル コード (オレンジの HueShift なし): TListBox をドロップし、lbOwnerDrawFixed を設定し、ItemHeight を 28 に調整し、フォントを「Segoe UI」に設定し、次の OnDrawItem を使用します。

プレビュー

var
   canvas : TCanvas;
   txt : String;
begin
   canvas:=ListBox1.Canvas;
   canvas.Brush.Style:=bsSolid;
   canvas.Brush.Color:=clWindow;
   canvas.FillRect(Rect);
   InflateRect(Rect, -2, -2);
   if odSelected in State then begin
      canvas.Pen.Color:=RGB(194, 118, 43);
      canvas.Brush.Color:=RGB(255, 228, 138);
      canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, 6, 6);
      canvas.Pen.Color:=RGB(246, 200, 103);
      canvas.RoundRect(Rect.Left+1, Rect.Top+1, Rect.Right-1, Rect.Bottom-1, 6, 6);
   end;
   canvas.Font.Color:=clWindowText;
   canvas.Brush.Style:=bsClear;
   txt:=ListBox1.Items[Index];
   Rect.Left:=Rect.Left+10;
   canvas.TextRect(Rect, txt, [tfLeft, tfSingleLine, tfVerticalCenter]);
end;

このようなコンポーネントを複数持つ場合は、TListBox を単にサブクラス化する方が望ましいのはもちろんです。RoundRect のアンチエイリアシングが必要な場合は、GR32 または GDI+ を使用できます。

XP との下位互換性のために、「Segoe UI」フォントは XP では使用できないため、動的に設定する必要があることに注意してください (XP では、「Arial」は適切な代替手段であり、「Tahoma」は近くに見えますが、そこにあるとは限りません)。

于 2013-05-27T14:42:47.520 に答える
8

TButtonGroupコンポーネントを使用でき ます。

VCL スタイルを使用するのが最も簡単な解決策ですが、あなたが言ったように、XE2 でスタイルを使用するのは非常に不快です。私の意見では、この機能は XE3 でのみ実際に実行可能になりました。

デフォルトの描画方法を使用するというあなたの要求に従って、私は私の解決策を提出しています。

プロジェクトのソースコードはこちらから入手できます。

このプロジェクトには画像が必要です。画像はプロジェクトと一緒に圧縮されます。

XE4 でコンパイルおよびテスト済み。

カスタム ビジュアル エフェクトを使用した TButtonGroup の例 

type

  TButtonGroup = class(Vcl.ButtonGroup.TButtonGroup)
   protected
     procedure Paint; override;
  end;

  TForm1 = class(TForm)
    ButtonGroup1: TButtonGroup;
    Panel1: TPanel;
    procedure ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
      Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MBitmap : TBitmap;

implementation

{$R *.dfm}

procedure TButtonGroup.Paint;
var
  R : TRect;
begin
   inherited;
   R := GetClientRect;
   R.Top := Self.Items.Count * Self.ButtonHeight;
   {Remove the clBtnFace background default Painting}
   Self.Canvas.FillRect(R);
end;

procedure TForm1.ButtonGroup1DrawButton(Sender: TObject; Index: Integer;
  Canvas: TCanvas; Rect: TRect; State: TButtonDrawState);
var
  TextLeft, TextTop: Integer;
  RectHeight: Integer;
  ImgTop: Integer;
  Text : String;
  TextOffset: Integer;
  ButtonItem: TGrpButtonItem;
  InsertIndication: TRect;
  DrawSkipLine : TRect;
  TextRect: TRect;
  OrgRect: TRect;

begin

    //OrgRect := Rect;  //icon
    Canvas.Font := TButtonGroup(Sender).Font;

      if bdsSelected in State then begin
         Canvas.CopyRect(Rect,MBitmap.Canvas,
                         System.Classes.Rect(0, 0, MBitmap.Width, MBitmap.Height));
         Canvas.Brush.Color := RGB(255,228,138);
      end
      else if bdsHot in State then
      begin
        Canvas.Brush.Color := RGB(194,221,244);
        Canvas.Font.Color := clBlack;

      end
       else
        Canvas.Brush.color := clWhite;

      if not (bdsSelected in State)
      then
        Canvas.FillRect(Rect);


      InflateRect(Rect, -2, -1);


    { Compute the text location }
    TextLeft := Rect.Left + 4;
    RectHeight := Rect.Bottom - Rect.Top;
     TextTop := Rect.Top + (RectHeight - Canvas.TextHeight('Wg')) div 2; { Do not localize }
    if TextTop < Rect.Top then
      TextTop := Rect.Top;
    if bdsDown in State then
    begin
      Inc(TextTop);
      Inc(TextLeft);
    end;

    ButtonItem := TButtonGroup(Sender).Items.Items[Index];

    TextOffset := 0;

    { Draw the icon  - if you need to display icons}

//    if (FImages <> nil) and (ButtonItem.ImageIndex > -1) and
//        (ButtonItem.ImageIndex < FImages.Count) then
//    begin
//      ImgTop := Rect.Top + (RectHeight - FImages.Height) div 2;
//      if ImgTop < Rect.Top then
//        ImgTop := Rect.Top;
//      if bdsDown in State then
//        Inc(ImgTop);
//      FImages.Draw(Canvas, TextLeft - 1, ImgTop, ButtonItem.ImageIndex);
//      TextOffset := FImages.Width + 1;
//    end;


    { Show insert indications }

    if [bdsInsertLeft, bdsInsertTop, bdsInsertRight, bdsInsertBottom] * State <> [] then
    begin
      Canvas.Brush.Color := clSkyBlue;
      InsertIndication := Rect;
      if bdsInsertLeft in State then
      begin
        Dec(InsertIndication.Left, 2);
        InsertIndication.Right := InsertIndication.Left + 2;
      end
      else if bdsInsertTop in State then
      begin
        Dec(InsertIndication.Top);
        InsertIndication.Bottom := InsertIndication.Top + 2;
      end
      else if bdsInsertRight in State then
      begin
        Inc(InsertIndication.Right, 2);
        InsertIndication.Left := InsertIndication.Right - 2;
      end
      else if bdsInsertBottom in State then
      begin
        Inc(InsertIndication.Bottom);
        InsertIndication.Top := InsertIndication.Bottom - 2;
      end;
      Canvas.FillRect(InsertIndication);
      //Canvas.Brush.Color := FillColor;
    end;

    if gboShowCaptions in TButtonGroup(Sender).ButtonOptions then
    begin
      { Avoid clipping the image }
      Inc(TextLeft, TextOffset);
      TextRect.Left := TextLeft;
      TextRect.Right := Rect.Right - 1;
      TextRect.Top := TextTop;
      TextRect.Bottom := Rect.Bottom -1;
      Text := ButtonItem.Caption;
      Canvas.TextRect(TextRect, Text, [tfEndEllipsis]);
    end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MBitmap := TBitmap.Create;
  try
  MBitmap.LoadFromFile('bg.bmp');
  except
    on E : Exception do
      ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MBitmap.Free;
end;

DFM :

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 398
  ClientWidth = 287
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  StyleElements = []
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    AlignWithMargins = True
    Left = 5
    Top = 5
    Width = 137
    Height = 388
    Margins.Left = 5
    Margins.Top = 5
    Margins.Right = 5
    Margins.Bottom = 5
    Align = alLeft
    BevelKind = bkFlat
    BevelOuter = bvNone
    Color = clWhite
    ParentBackground = False
    TabOrder = 0
    StyleElements = [seFont]
    object ButtonGroup1: TButtonGroup
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 125
      Height = 378
      Margins.Left = 4
      Margins.Top = 4
      Margins.Right = 4
      Margins.Bottom = 2
      Align = alClient
      BevelInner = bvNone
      BevelOuter = bvNone
      BorderStyle = bsNone
      ButtonOptions = [gboFullSize, gboGroupStyle, gboShowCaptions]
      DoubleBuffered = True
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Segoe UI'
      Font.Style = []
      Items = <
        item
          Caption = 'General'
        end
        item
          Caption = 'Display'
        end
        item
          Caption = 'Proofing'
        end
        item
          Caption = 'Save'
        end
        item
          Caption = 'Language'
        end
        item
          Caption = 'Advanced'
        end>
      ParentDoubleBuffered = False
      TabOrder = 0
      OnDrawButton = ButtonGroup1DrawButton
    end
  end
end

そこには、TButtonGroup をホストする Panel コンテナがあります。これは必要ではなく、視覚的な改善のために追加されただけです。

実行時に選択範囲の色を変更する場合は、efg の色相/彩度メソッドを使用して画像の色相を変更することをお勧めします。この方法では、カラー パネルはそのままですが、色は変更されます。

VCL スタイルのサポートを取得するには、TButtonGroup コンポーネントから ButtonGroup1DrawButton イベントを切り離すだけです。これにより、デフォルトの DrawButton イベントが開始され、そのサポートが追加されます。

于 2013-05-27T14:21:30.583 に答える
4

この外観には、 TMS Control のAdvanced Poly Pagerを使用します。強くお勧めします。これは非常に強力で柔軟なコントロール セットです。具体的には、TAdvPolyList配色をカスタム調整した Office スタイルのダイアログに使用します。TAdvOfficePager(これは見た目があまり良くないものとは異なることに注意してください。誤って 2 つを混同しないでください!)

次のことが可能になります。

  • 左側にカテゴリ セレクターがあります
  • ページ コントロールなので、右側のページにコントロールを簡単に配置できます (通常のページ コントロールと同じ)。
  • タブとページの間の視覚的なリンクを示します。これは、提供された Word のスクリーンショットにはありません (Word には間に障壁がありますが、このコントロールにはありません。より優れた、より直感的で、適切にリンクされた UI 設計です)。
  • 必要に応じて、clWindow などの色定数を使用できますが、何でも使用できます。
  • 画像、画像付きのテキスト、リンクなど、左側のパネルに表示できるさまざまな項目があります。Word のスクリーンショットには、要素の一部を区切る微妙な灰色の分割線があります。このコントロールでもこれを行うことができると確信していますが、TListBox のカスタム ペイントなど、ポスターが提供した他の回答のいくつかを確実に行うのは難しいでしょう。
  • 素晴らしく見える！

彼らのサイトの画像は、Office の外観を模倣する方法を完全に示しているわけではありませんが、これら 2 つのスクリーンショット (サイトの高解像度) から、達成できることの種類を確認できるはずです。

AdvPolyList Office メニュー エミュレーション

と

より優れたメニュー エミュレーション

私たちのメニューは 2 番目のスクリーンショットに似ていますが、単純なテキスト項目 (チェックボックスや画像などのような複雑なものは何もありません。できることを示すためだけに配置されていると思います) であり、よりあなたのような配色を使用し、さらに青を追加しました各ページのヘッダー。

数年前に購入しましたが、後悔したことはありません。強くお勧めします。

于 2013-05-27T15:50:05.873 に答える
-1

右側のパーツのページ コントロールです。左側の部分については、いくつかのオプションがあると思いますが、主なものはおそらく 1 列と速度ボタンを使用する GridLayout です。

難しすぎるわけではありませんが、少し厄介です。おそらく、ボタン部分を含むフレームを使用できます。

唯一難しいのは分離バーですが、それをサブクラス化し、特定のプロパティを持たせることで実現できるかもしれません。

よろしく、

あ

于 2013-05-27T12:53:17.740 に答える