ÿþunit RadioGroup; interface uses WebCore, WebUI, WebCtrls, WebCtnrs, WebBtns, WebForms; const CLIENT_ELEMENT_NAME = 'Client'; CAPTION_ELEMENT_NAME = 'Caption'; CAPTIONBACKGROUND_ELEMENT_NAME = 'CaptionBackground'; DEFAULT_PADDING_LEFT = 10; DEFAULT_PADDING_TOP = 15; type TRadioItem = class(TRadioButton) private { Private declarations } protected { Protected declarations } procedure InitializeProperties; override; function DoClick: Boolean; override; public { Public declarations } published { Published declarations } end; TRadioStrings = class(TStringList) private FRadioGroupControl: TRadioGroup; protected procedure HandleChanges; override; public constructor Create(AControl: TRadioGroup); virtual; published { Published declarations } end; {$INTERFACE TRadioGroup} type TRadioGroup = class(TControl) private { Private declarations } FClientElement: TElement; FClientTopMargin: integer; FCaptionElement: TElement; FCaptionBackgroundElement: TElement; FItems: TRadioStrings; FItemHeight: Integer; FCaption: String; FItemIndex: Integer = -1; FRadioItemCount: Integer; FUpdatingRadioItems: Boolean; FEnabled: Boolean; FReadOnly: Boolean; FColumns: Integer; FSpaceEvenly: Boolean; procedure SetItemIndex(Value: Integer); procedure SetItemHeight(Value: Integer); procedure SetRadioItemCount(Value: Integer); procedure SetColumns(Value: Integer); procedure SetSpaceEvenly(Value: Boolean); function CreateRadioItem: TRadioItem; procedure UpdateRadioItems; function GetRadioItem(AIndex: Integer): TRadioItem; function GetBackground: TBackground; function GetBorder: TBorder; function GetCorners: TCorners; function GetInsetShadow: TInsetShadow; function GetOutsetShadow: TOutsetShadow; function GetPadding: TPadding; function GetFont: TFont; function GetFormat: TFormat; function GetCaption: String; procedure SetCaption(Value: string); function GetEnabled: Boolean; procedure SetEnabled(Value: Boolean); function GetReadOnly: Boolean; procedure SetReadOnly(Value: Boolean); protected { Protected declarations } property RadioItemCount: Integer read FRadioItemCount write SetRadioItemCount; property RadioItems[AIndex: Integer]: TRadioItem read GetRadioItem; function GetInterfaceClassName: String; override; procedure CreateInterfaceElements; override; procedure InitializeProperties; override; function GetClientElement: TElement; override; procedure DoSize; override; public { Public declarations } procedure ItemsChanged; destructor Destroy; override; published { Published declarations } property Caption: string read GetCaption write SetCaption; property Items: TStrings read FItems; property ItemIndex: Integer read FItemIndex write SetItemIndex; property ItemHeight: Integer read FItemHeight write SetItemHeight; property Columns: Integer read FColumns write SetColumns; property SpaceEvenly: Boolean read FSpaceEvenly write SetSpaceEvenly; property Background: TBackground read GetBackground; property Padding: TPadding read GetPadding; property Border: TBorder read GetBorder; property Corners: TCorners read GetCorners; property InsetShadow: TInsetShadow read GetInsetShadow; property OutsetShadow: TOutsetShadow read GetOutsetShadow; property Font: TFont read GetFont; property Format: TFormat read GetFormat; property Top; property Left; property Height; property Width; property ActivateOnClick; property AlwaysOnTop; property Animations; property Constraints; property Cursor; property DisplayOrder; property Layout; property LayoutOrder; property Margins; property Opacity; property OutsetShadow; property TabOrder; property TabStop default True; property Tag; property Visible; property OnAnimationComplete; property OnAnimationsComplete; property OnShow; property OnHide; property OnMove; property OnSize; property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseEnter; property OnMouseLeave; property OnTouchStart; property OnTouchMove; property OnTouchEnd; property OnTouchCancel; property OnKeyDown; property OnKeyPress; property OnKeyUp; property Enabled: Boolean read GetEnabled write SetEnabled default True; property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False; end; implementation { TRadioItem } procedure TRadioItem.InitializeProperties; begin inherited InitializeProperties; CheckOwnerClass(TRadioGroup); end; function TRadioItem.DoClick: Boolean; begin Result := inherited DoClick; TRadioGroup(Owner).ItemIndex := Self.LayoutOrder; if Result then Result := TRadioGroup(Owner).DoClick; end; { TRadioStrings } constructor TRadioStrings.Create(AControl: TRadioGroup); begin inherited Create; FRadioGroupControl := AControl; end; procedure TRadioStrings.HandleChanges; begin FRadioGroupControl.ItemsChanged; inherited HandleChanges; end; { TRadioGroup } destructor TRadioGroup.Destroy; begin FItems.Free; FItems := nil; inherited Destroy; end; procedure TRadioGroup.ItemsChanged; begin UpdateRadioItems; end; function TRadioGroup.GetInterfaceClassName: String; begin Result := TRadioGroup.ClassName; end; procedure TRadioGroup.InitializeProperties; var TempItem: TRadioItem; begin inherited InitializeProperties; FItems := TRadioStrings.Create(Self); InterfaceState := NORMAL_STATE_NAME; FClientTopMargin := FClientElement.Margins.Top; //FCaptionBackgroundElement.Background.Fill.Color := FClientElement.Background.Fill.Color; FColumns := 1; FEnabled := True; FReadOnly:= False; BeginUpdate; try TempItem := CreateRadioItem; try FItemHeight := TempItem.Height; finally TempItem.Free; end; finally EndUpdate; end; FSpaceEvenly := false; FClientElement.Padding.Left := DEFAULT_PADDING_LEFT; FClientElement.Padding.Top := DEFAULT_PADDING_TOP; end; procedure TRadioGroup.SetItemIndex(Value: Integer); begin if (Value <> -1) then begin if Value > (FRadioItemCount -1) then exit; FItemIndex := Value; RadioItems[Value].SelectionState := ssSelected; end else if (FItemIndex <> -1) then begin RadioItems[FItemIndex].SelectionState := ssIndeterminate; FItemIndex := Value; end; end; procedure TRadioGroup.SetItemHeight(Value: Integer); begin if FItemHeight <> Value then begin FItemHeight := Value; UpdateRadioItems; end; end; function TRadioGroup.GetRadioItem(AIndex: Integer): TRadioItem; begin Result := TRadioItem(Controls[AIndex]); end; procedure TRadioGroup.UpdateRadioItems; var i, j, WrapIndex: Integer; TempItem: TRadioItem; begin if (not FUpdatingRadioItems) then begin FUpdatingRadioItems := True; try BeginUpdate; try SetRadioItemCount(FItems.Count); j := 1; WrapIndex := Ceil(FRadioItemCount/FColumns); for i := 0 to FRadioItemCount -1 do begin TempItem := RadioItems[i]; TempItem.Caption := FItems[i]; TempItem.Font.Name := Font.Name; TempItem.Font.Size := Font.Size; TempItem.Font.Color := Font.Color; TempItem.Height := FItemHeight; TempItem.Enabled := FEnabled; TempItem.ReadOnly := FReadOnly; if FSpaceEvenly then begin TempItem.AutoWidth := false; TempItem.Width := (FClientElement.Width - FClientElement.Padding.Left - FClientElement.Padding.Right) div FColumns; end else begin TempItem.AutoWidth := true; end; if j = WrapIndex then begin j := 1; TempItem.Layout.Consumption := lcRight; TempItem.Layout.Reset := True; end else begin inc(j); TempItem.Layout.Consumption := lcBottom; TempItem.Layout.Reset := False; end; end; finally EndUpdate; end; finally FUpdatingRadioItems := False; end; end; end; function TRadioGroup.CreateRadioItem: TRadioItem; begin Result := TRadioItem.Create(Self); with Result do begin Layout.Position := lpTopLeft; Layout.Consumption := lcBottom; end; end; procedure TRadioGroup.SetRadioItemCount(Value: Integer); var i: Integer; TempRadioItem: TRadioItem; begin try if (Value > FRadioItemCount) then begin for i := (FRadioItemCount +1 ) to Value do CreateRadioItem; end else if (Value < FRadioItemCount) then begin for i := FRadioItemCount-1 downto Value do begin TempRadioItem := GetRadioItem(i); if TempRadioItem.SelectionState = ssSelected then SetItemIndex(-1); TempRadioItem.Free; TempRadioItem := NIL; end; end; finally FRadioItemCount := Value; FCaptionBackgroundElement.Background.Fill.Color := FClientElement.Background.Fill.Color; end; end; procedure TRadioGroup.SetColumns(Value: Integer); begin if Value <> FColumns then begin if Value > FRadioItemCount then exit; FColumns := Value; UpdateRadioItems; end; end; procedure TRadioGroup.SetSpaceEvenly(Value: Boolean); begin if Value <> FSpaceEvenly then begin FSpaceEvenly := Value; UpdateRadioItems; end; end; function TRadioGroup.GetClientElement: TElement; begin Result := FClientElement; end; procedure TRadioGroup.CreateInterfaceElements; begin inherited CreateInterfaceElements; FCaptionElement := InterfaceManager.CreateElement(CAPTION_ELEMENT_NAME,Element, ELEMENT_CLASS_DIV); FClientElement := InterfaceManager.CreateElement(CLIENT_ELEMENT_NAME,Element,ELEMENT_CLASS_DIV); FCaptionBackgroundElement := InterfaceManager.CreateElement(CAPTIONBACKGROUND_ELEMENT_NAME,Element, ELEMENT_CLASS_DIV); end; procedure TRadioGroup.DoSize; begin if FSpaceEvenly then UpdateRadioItems; Inherited DoSize; end; function TRadioGroup.GetCaption: String; begin Result := FCaptionElement.Content; end; procedure TRadioGroup.SetCaption(Value: string); begin if Value <> FCaption then begin FCaption := Value; FCaptionElement.Content := FCaption; FCaptionBackgroundElement.Width := FCaptionElement.Width; end; if (FCaptionElement.Content <> '') then begin FCaptionElement.Visible := True; FCaptionBackgroundElement.Background.Fill.Color := FClientElement.Background.Fill.Color; FClientElement.Margins.Top := FClientTopMargin; end else begin FCaptionElement.Visible := False; FCaptionBackgroundElement.Background.Fill.Color := clTransparent; FClientElement.Margins.Top := 0; end; end; function TRadioGroup.GetBackground: TBackground; begin Result := FClientElement.Background; FCaptionBackgroundElement.Background.Fill.Color := FClientElement.Background.Fill.Color; end; function TRadioGroup.GetPadding: TPadding; begin Result := FClientElement.Padding; end; function TRadioGroup.GetBorder: TBorder; begin Result := FClientElement.Border; end; function TRadioGroup.GetCorners: TCorners; begin Result := FClientElement.Corners; end; function TRadioGroup.GetInsetShadow: TInsetShadow; begin Result := Element.InsetShadow; end; function TRadioGroup.GetOutsetShadow: TOutsetShadow; begin Result := Element.OutsetShadow; end; function TRadioGroup.GetFont: TFont; begin Result := FCaptionElement.Font; UpdateRadioItems; end; function TRadioGroup.GetFormat: TFormat; begin Result := FCaptionElement.Format; end; function TRadioGroup.GetEnabled: Boolean; begin Result:= FEnabled; end; procedure TRadioGroup.SetEnabled(Value: Boolean); begin FEnabled:= Value; UpdateRadioItems; end; function TRadioGroup.GetReadOnly: Boolean; begin Result:= FReadOnly; end; procedure TRadioGroup.SetReadOnly(Value: Boolean); begin FReadOnly:= Value; UpdateRadioItems; end; end.