delphi - कैसे वर्ड 2010-शैली विकल्प श्रेणी चयनकर्ता अनुकरण




button ms-office (3)

Word 2010 में विकल्प संवाद श्रेणी चयनकर्ता को श्वेत "टॉगल" बटन के माध्यम से लागू करता है जो क्लिक किए जाने पर क्लिक करते समय (चयनित) नारंगी बन जाते हैं।

डेल्फी में ऐसे व्यवहार को फिर से कैसे कार्यान्वित करेगा? वर्तमान विंडोज थीम के साथ एक अनुरूपता आवश्यक है (यानी CLWindow के रूप में बटन रंग को निर्दिष्ट करने के लिए संभव है, CLWhite नहीं)।

संपादित करें: स्पष्ट करने के लिए - मुझे केवल बाईं ओर श्रेणी चयनकर्ता के साथ समस्याएं हैं I सब कुछ काफी सरल है


आप शैली सेट के साथ TListBox का उपयोग lbOwnerDrawFixed पर कर सकते हैं (यदि अंतर का आकार महत्वपूर्ण नहीं है) या lbOwnerDrawVariable यदि यह है

तब आप ऑनड्राइटीम और ऑनमेयर आईटम्स को तदनुसार संभाल सकते हैं।

क्लाउन्डोवा का प्रयोग करने में कोई समस्या नहीं होगी, हालांकि AFAIK नारंगी रंग विंडोज थीम का हिस्सा नहीं है, लेकिन आप कुछ ऐसा प्राप्त कर सकते हैं जो क्लाइहाइटलाइट से शुरू करके थीम को मैच करेगा और उसके बाद रंग का बदलाव लागू करेगा, फिर छायांकन के लिए हल्के बदलाव।

यदि आपका रंग बदलाव निरंतर है, तो वह स्वचालित रूप से थीम रंगों के लिए अनुकूल होगा

नमूना कोड (नारंगी के लिए ह्यूशफ्ट के बिना): एक TListBox ड्रॉप करें, लेबोनर ड्रॉफिक्स सेट करें, 28 से आइटम हैइटइट को समायोजित करें, फ़ॉन्ट को "सेगोई 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 ​​के साथ पिछड़े संगतता के लिए, "सेगोई UI" फ़ॉन्ट को गतिशील रूप से सेट किया जाना चाहिए, क्योंकि यह XP में उपलब्ध नहीं है (XP में "एरियल" एक अच्छा फ़ॉलबैक है, "ताहोमा" करीब दिखता है, लेकिन वहां होने की गारंटी नहीं है)


मैंने सोचा होगा कि आप दो चीजों का उपयोग कर सकते हैं: दाईं तरफ भाग के लिए एक पेज नियंत्रण। बाईं तरफ भाग के लिए मुझे लगता था कि आपके पास कुछ विकल्प हैं, मुख्यतः 1 कॉलम और स्पीड बटन का इस्तेमाल करते हुए ग्रिड लेआउट।

अधिक कठिन नहीं है, लेकिन थोड़ा गन्दा। आप संभवत: फ़्रेम के साथ बटन भाग को शामिल करने के लिए कर सकते हैं

एकमात्र कठिन सा अलगाव की सलाखों होगी, लेकिन हो सकता है कि आप इसे उप-क्लासिंग करके और विशिष्ट गुण प्राप्त कर सकें।

सादर,


आप TButtonGroup घटक का उपयोग कर सकते हैं

वीसीएल शैलियाँ का उपयोग करना सबसे आसान समाधान है, लेकिन जैसा कि आपने कहा, XE2 में शैलियों का उपयोग करना काफी असहज है, मेरी राय में यह सुविधा केवल वास्तव में XE3 में व्यवहार्य हो गई है।

डिफ़ॉल्ट पेंटिंग विधियों का उपयोग करने के आपके अनुरोध के अनुसार मैं अपना समाधान सबमिट कर रहा हूं,

यहां उपलब्ध प्रोजेक्ट का स्रोत कोड।

इस परियोजना के लिए एक छवि की आवश्यकता है, छवि परियोजना के साथ एक साथ ज़िपित की गई है।

संकलित और XE4 में परीक्षण किया

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;

डीएफएम:

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

टीबुटोन ग्रुप की मेजबानी में एक पैनल कंटेनर है, इसकी जरूरी नहीं है, बस दृश्य सुधार के लिए जोड़ा गया है।

यदि आप रनटाइम पर चयन का रंग बदलना चाहते हैं तो मैं छवि का ह्यू बदलने के लिए efg के ह्यू / संतृप्ति विधि का उपयोग करने का सुझाव देता हूं, इस तरह रंग पैनल रहता है लेकिन रंग बदल जाएगा।

वीसीएल शैलियों के लिए समर्थन हासिल करने के लिए बस टीबुटन ग्रुप घटक से बटन ग्रुप 1 ड्रेबूटन इवेंट को अलग करना, उस तरह से डिफॉल्ट ड्राबूटन इवेंट लॉक कर सकता है जिसमें उस के लिए समर्थन जोड़ा जाता है





ms-office