Summary Table
Categories |
Total Count |
PII |
0 |
URL |
0 |
DNS |
0 |
EKL |
0 |
IP |
0 |
PORT |
0 |
VsID |
0 |
CF |
0 |
AI |
0 |
VPD |
0 |
PL |
0 |
Other |
0 |
File Content
unit ORRadioCheck;
interface
uses Windows, Classes, SysUtils, ComCtrls, ExtCtrls, StdCtrls, Controls, Graphics, Messages, ORStaticText;
const
OR_DEFAULT_SPACING = 3;
DEFAULT_ICON_SIZE = 17; // default size
DEFAULT_MAX_WIDTH = 0;
type
TORRadioCheck = class(TPanel)
private
fCheck: TCheckbox;
fRadio: TRadioButton;
fSingleLine: boolean;
fFocusOnBox: boolean;
fGrayedToChecked: boolean;
fAllowAllUnchecked: boolean;
fAssociate: TControl;
fSpacing: integer;
fUseRadioStyle: boolean;
fPreDelimiter: TSysCharSet;
fPostDelimiter: TSysCharSet;
IconSize: integer;
FontHeight: integer;
fLines: TStrings; // property holder for Lines
fDisplayed: TStringList;
fTransparent: boolean; // property holder for Transparent
fVerticalSpace: integer; // property holder for VerticalSpace
Resizing: boolean; // flag stating the control is resizing
Painting: boolean;
FirstTime: boolean; // flag stating the control needs initialization
fWordWrap: boolean;
fMaxWidth: integer;
fWrapByChar: boolean;
fPauseResize: boolean;
ResizeRequested: boolean;
LargestPixelWidth: longint;
fClicksDisabled: Boolean;
FStringData: string;
function GetGroupIndex: integer;
procedure SetAssociate(const Value: TControl);
procedure SetGroupIndex(const Value: integer);
procedure SetUseRadioStyle(const Value: boolean);
procedure SetSpacing(const Value: integer);
function GetSingleLine: boolean;
procedure TextToCanvas(y: integer; s: string);
procedure SetMaxWidth(const Value: integer);
procedure SetWrapByChar(const Value: boolean);
procedure SyncAllowAllUnchecked;
procedure SetPostDelimiter(const Value: TSysCharSet);
procedure SetPreDelimiter(const Value: TSysCharSet);
function GetChecked: boolean;
procedure SetChecked(const Value: boolean);
function GetText: string;
function GetLine(const idx: integer): string;
procedure SetLine(const idx: integer; const Value: string);
function GetCount: integer;
function BoxWidth: integer;
procedure SetFocusOnBox(const Value: boolean);
function GetState: TCheckBoxState;
procedure SetState(const Value: TCheckBoxState);
function GetCaption: string;
procedure SetCaption(const Value: string);
protected
procedure DoEnter; override; // fires when the control is entered; used for displaying the focus status
procedure DoExit; override; // fires when the control is exited; used for displaying the focus status
procedure SetName(const Value: TComponentName); override; // Sets the text in the control when the name is changed
procedure SetAllowAllUnchecked(const Value: boolean);
procedure UpdateAssociate;
procedure Paint; override;
procedure Resize; override;
procedure RefreshParts;
procedure SetLines(const Value: TStrings); // write accessor for Lines
procedure SetText(const Value: string); // write accessor for Text
procedure SetVerticalSpace(const Value: integer); // write accessor for VerticalSpace
procedure SetTransparent(const Value: boolean); // write accessor for Transparent
procedure SetWordWrap(const Value: boolean);
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function LargestTextWidth: longint;
property ClicksDisabled: Boolean read FClicksDisabled write FClicksDisabled;
public
property Caption: string read GetCaption write SetCaption;
property Displayed: TStringList read fDisplayed;
constructor Create(AOwner: TComponent); override; // constructor
destructor Destroy; override; // destructor
procedure PauseResize;
procedure ResumeResize;
property SingleLine: boolean read GetSingleLine;
property PreDelimiters: TSysCharSet read fPreDelimiter write SetPreDelimiter;
property PostDelimiters: TSysCharSet read fPostDelimiter write SetPostDelimiter;
property Checkbox: TCheckbox read fCheck write fCheck;
property RadioButton: TRadioButton read fRadio write fRadio;
property DockManager;
property Line[const idx: integer]: string read GetLine write SetLine; // user-formatted text; CRLF delimited
property StringData: string read FStringData write FStringData;
published
property AutoSize;
property AllowAllUnchecked: boolean read FAllowAllUnchecked write SetAllowAllUnchecked default True;
property Associate: TControl read FAssociate write SetAssociate;
property GroupIndex: integer read GetGroupIndex write SetGroupIndex default 0;
property Spacing: integer read fSpacing write SetSpacing default OR_DEFAULT_SPACING;
property UseRadioStyle: boolean read fUseRadioStyle write SetUseRadioStyle default False;
property Checked: boolean read GetChecked write SetChecked;
property Text: string read GetText write SetText;
property Lines: TStrings read fLines write SetLines;
property Transparent: boolean read fTransparent write SetTransparent default True; // determines if the background is transparent
property VerticalSpace: integer read fVerticalSpace write SetVerticalSpace default DEFAULT_ICON_SIZE; // number of vertical pixel spaces between items when using multi-line
property WordWrap: boolean read fWordWrap write SetWordWrap default False;
property MaxWidth: integer read fMaxWidth write SetMaxWidth default DEFAULT_MAX_WIDTH;
property WrapByChar: boolean read fWrapByChar write SetWrapByChar default False;
property Count: integer read GetCount;
property FocusOnBox: boolean read FFocusOnBox write SetFocusOnBox default false;
property State: TCheckBoxState read GetState write SetState;
end;
implementation
uses ORFn, Math, System.UITypes;
{ TORRadioCheck }
function TORRadioCheck.BoxWidth: integer;
begin
Result := Max(fCheck.Width, fRadio.Width);
end;
function TORRadioCheck.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if HandleAllocated and (Align <> alClient) and
(not (csDesigning in ComponentState) or (ControlCount > 0)) then
begin
NewWidth := Max(fRadio.Width, fCheck.Width) + fSpacing + LargestTextWidth + Margins.Left + Margins.Right;
NewHeight := Max(fDisplayed.Count * FontHeight, fCheck.Height) + Margins.Top + Margins.Bottom + (fVerticalSpace * fLines.Count);
end;
end;
constructor TORRadioCheck.Create(AOwner: TComponent);
begin
inherited;
IconSize := DEFAULT_ICON_SIZE; // default size
BevelInner := bvNone;
BevelOuter := bvNone;
ShowCaption := False;
ParentFont := True;
// initialize objects
fLines := TStringList.Create;
fDisplayed := TStringList.Create;
// set internal property values
fMaxWidth := DEFAULT_MAX_WIDTH;
fTransparent := True;
fVerticalSpace := OR_DEFAULT_SPACING;
fWordWrap := False;
Caption := '';
fWrapByChar := False;
fPauseResize := False;
ResizeRequested := False;
// set flags
Resizing := False;
Painting := False;
FirstTime := True;
// set inherited property values
BevelInner := bvNone;
BevelOuter := bvNone;
Alignment := taLeftJustify;
fSpacing := OR_DEFAULT_SPACING;
Height := IconSize + Margins.Top + Margins.Bottom;
Width := IconSize + Margins.Left + Margins.Right + fSpacing;
FontHeight := FontHeightInPixels(Font);
fCheck := TCheckbox.Create(Self);
fCheck.Parent := Self;
fCheck.Left := 0;
fCheck.Top := 0;
fCheck.Caption := '';
fCheck.Width := fCheck.Height;
IconSize := fCheck.Height;
fCheck.ParentFont := True;
fCheck.Visible := True;
fCheck.OnClick := Self.OnClick;
fRadio := TRadioButton.Create(Self);
fRadio.Parent := Self;
fRadio.Left := 0;
fRadio.Top := 0;
fRadio.Width := fRadio.Height;
fRadio.Caption := '';
fRadio.Visible := False;
fRadio.ParentFont := True;
fRadio.OnClick := Self.OnClick;
UseRadioStyle := False;
fSingleLine := True;
fFocusOnBox := False;
fGrayedToChecked := True;
fAllowAllUnchecked := True;
fAssociate := nil;
end;
destructor TORRadioCheck.Destroy;
begin
// free up objects
if assigned(fLines) then fLines.Free;
if assigned(fDisplayed) then fDisplayed.Free;
inherited;
end;
procedure TORRadioCheck.DoEnter;
begin
Paint;
inherited;
end;
procedure TORRadioCheck.DoExit;
begin
Paint;
inherited;
end;
function TORRadioCheck.GetCaption: string;
begin
Result := GetText;
end;
function TORRadioCheck.GetChecked: boolean;
begin
Result := fCheck.Checked;
end;
function TORRadioCheck.GetCount: integer;
begin
Result := fLines.Count;
end;
function TORRadioCheck.GetGroupIndex: integer;
begin
Result := fRadio.Tag;
end;
function TORRadioCheck.GetLine(const idx: integer): string;
begin
if (idx >= 0) and (idx < Count) then
Result := fLines[idx]
else
raise exception.Create('line index out of bounds (' + IntToStr(idx) + ')');
end;
function TORRadioCheck.GetSingleLine: boolean;
begin
Result := (fLines.Count = 1); // assumption: this may need to be < 2
end;
function TORRadioCheck.GetState: TCheckBoxState;
begin
Result := fCheck.State;
end;
function TORRadioCheck.GetText: string;
begin
Result := fLines.Text;
end;
function TORRadioCheck.LargestTextWidth: longint;
var
i: integer;
begin
Result := 0;
for i := 0 to (fLines.Count - 1) do begin
if Trim(fLines[i]) <> '' then begin
Result := Max(FontWidthInPixels(Font, fLines[i]), Result);
end;
end;
end;
procedure TORRadioCheck.Paint;
var
r: TRect; // rectangle used to draw the border
i: integer; // loops
OldPenColor, // saves the former pen color while drawing the border
OldBrushColor: TColor; // saves the former brush color while drawing the border
OldPenStyle: TPenStyle; // saves the former pen style while drawing the border
OldBrushStyle: TBrushStyle; // saves the former brush style while drawing the border
begin
if assigned(Canvas) then begin
if not Painting then begin
Painting := True;
try
FontHeight := FontHeightInPixels(Font);
fCheck.Visible := (not fUseRadioStyle);
fRadio.Visible := fUseRadioStyle;
if fUseRadioStyle then begin
fCheck.Width := 0;
fRadio.Width := IconSize;
end else begin
fCheck.Width := IconSize;
fRadio.Width := 0;
end;
fCheck.Top := Max(fCheck.Height, FontHeight) - fCheck.Height + Margins.Top;
fRadio.Top := fCheck.Top;
{------------------}
{ Draw the outline }
{------------------}
OldBrushColor := Canvas.Brush.Color;
OldBrushStyle := Canvas.Brush.Style;
OldPenColor := Canvas.Pen.Color; // save old settings
OldPenStyle := Canvas.Pen.Style;
try
Canvas.Font.Assign(Font); // make sure using the correct font to draw with
Canvas.Pen.Width := 1;
if Transparent then begin
Canvas.Brush.Style := bsClear;
Canvas.Brush.Color := clNone;
end else begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Color;
end;
Canvas.Brush.Color := clNone;
Canvas.Brush.Style := bsClear;
if Focused then begin // focused control uses dotted line in font color
Canvas.Pen.Style := psDot;
Canvas.Pen.Color := Font.Color;
end else begin // normal drawing just draws a rectangle that overwrites previous rectangles
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := Color;
end;
r := Rect(0, 0, Width, Height);
if Transparent then begin
Canvas.TextFlags := 0;
Canvas.FrameRect(r);
end else begin
Canvas.TextFlags := ETO_OPAQUE;
Canvas.Rectangle(r); // draw the rectangle
end;
{---------------}
{ Draw the text }
{---------------}
// write out the strings after determining if they are wrapped
for i := 0 to (fDisplayed.Count - 1) do begin // loop through lines, determine if they need wrapped
TextToCanvas(Margins.Top + (i * (FontHeight + VerticalSpace)), fDisplayed[i]);
end;
finally
Canvas.Brush.Color := OldBrushColor;
Canvas.Brush.Style := OldBrushStyle;
Canvas.Pen.Color := OldPenColor;
Canvas.Pen.Style := OldPenStyle;
end;
finally
Painting := False;
end;
end;
end;
end;
procedure TORRadioCheck.PauseResize;
begin
fPauseResize := True;
end;
procedure TORRadioCheck.RefreshParts;
begin
fCheck.Repaint;
fRadio.Repaint;
Invalidate;
end;
procedure TORRadioCheck.Resize;
var
i: integer;
sl: TStringList;
WorkWidth: integer;
begin
inherited;
FontHeight := FontHeightInPixels(Font);
if fPauseResize then begin
ResizeRequested := True;
end else begin
if not Resizing then begin
Resizing := True;
try
fDisplayed.Clear;
LargestPixelWidth := FindFontMetrics(Font).tmMaxCharWidth;
if fWordWrap then begin // word handling is Word Wrap
if (fMaxWidth > 0) then begin
WorkWidth := Min(LargestTextWidth, fMaxWidth);
end else begin
WorkWidth := Width - fSpacing - BoxWidth;
end;
for i := 0 to (fLines.Count - 1) do begin
if fWrapByChar and (fMaxWidth > 0) then
sl := WrapTextByChar(fLines[i], fMaxWidth, Canvas, PreSeparatorChars, PostSeparatorChars)
else
sl := WrapTextByPixels(fLines[i], WorkWidth, Canvas, PreSeparatorChars, PostSeparatorChars);
fDisplayed.AddStrings(sl);
end;
end else begin // no word wrapping
fDisplayed.Text := fLines.Text;
end;
Invalidate;
finally
Resizing := False;
end;
end;
end;
end;
procedure TORRadioCheck.ResumeResize;
begin
fPauseResize := False;
if ResizeRequested then Resize;
end;
procedure TORRadioCheck.SetAllowAllUnchecked(const Value: boolean);
begin
FAllowAllUnchecked := Value;
SyncAllowAllUnchecked;
end;
procedure TORRadioCheck.SetAssociate(const Value: TControl);
begin
if (FAssociate <> Value) then
begin
if (assigned(FAssociate)) then
FAssociate.RemoveFreeNotification(Self);
FAssociate := Value;
if (assigned(FAssociate)) then
begin
FAssociate.FreeNotification(Self);
UpdateAssociate;
end;
end;
end;
procedure TORRadioCheck.UpdateAssociate;
procedure EnableCtrl(Ctrl: TControl; DoCtrl: boolean);
var
i: integer;
DoIt: boolean;
begin
if DoCtrl then
Ctrl.Enabled := Checked;
// added (csAcceptsControls in Ctrl.ControlStyle) below to prevent disabling of
// child sub controls, like the TBitBtn in the TORComboBox. If the combo box is
// already disabled, we don't want to disable the button as well - when we do, we
// lose the disabled glyph that is stored on that button for the combo box.
if (Ctrl is TWinControl) and (csAcceptsControls in Ctrl.ControlStyle) then
begin
for i := 0 to TWinControl(Ctrl).ControlCount - 1 do
begin
if DoCtrl then
DoIt := TRUE
else
DoIt := (TWinControl(Ctrl).Controls[i] is TWinControl);
if DoIt then
EnableCtrl(TWinControl(Ctrl).Controls[i], TRUE);
end;
end;
end;
begin
if (assigned(FAssociate)) then
EnableCtrl(FAssociate, FALSE);
end;
procedure TORRadioCheck.SetCaption(const Value: string);
begin
SetText(Value);
end;
procedure TORRadioCheck.SetChecked(const Value: boolean);
begin
if (Value <> fCheck.Checked) or (Value <> fRadio.Checked) then begin
fCheck.Checked := Value;
fRadio.Checked := Value;
end;
invalidate;
end;
procedure TORRadioCheck.SetFocusOnBox(const Value: boolean);
begin
fFocusOnBox := Value;
invalidate;
end;
procedure TORRadioCheck.SetGroupIndex(const Value: integer);
begin
fRadio.Tag := Value;
end;
procedure TORRadioCheck.SetLine(const idx: integer; const Value: string);
begin
if (idx >= 0) and (idx < Count) then begin
if fLines[idx] <> Value then begin
fLines[idx] := Value;
Resize;
end;
end else
raise exception.Create('line index out of bounds (' + IntToStr(idx) + ')');
end;
procedure TORRadioCheck.SetLines(const Value: TStrings);
begin
if (Value.Text <> fLines.Text) then begin
fLines.Text := Value.Text;
Resize;
end;
end;
procedure TORRadioCheck.SetMaxWidth(const Value: integer);
begin
if (fMaxWidth <> Value) then begin
fMaxWidth := Value;
Resize;
end;
end;
procedure TORRadioCheck.SetName(const Value: TComponentName);
begin
inherited;
if (Name <> Value) then begin
inherited SetName(Value);
fLines.Text := Name;
end;
end;
procedure TORRadioCheck.SetPostDelimiter(const Value: TSysCharSet);
begin
fPostDelimiter := Value;
end;
procedure TORRadioCheck.SetPreDelimiter(const Value: TSysCharSet);
begin
fPreDelimiter := Value;
end;
procedure TORRadioCheck.SetUseRadioStyle(const Value: boolean);
begin
if (Value <> fUseRadioStyle) then begin
fUseRadioStyle := Value;
end;
Repaint;
end;
procedure TORRadioCheck.SetVerticalSpace(const Value: integer);
begin
if (fVerticalSpace <> Value) then begin
fVerticalSpace := Value;
Invalidate;
end;
end;
procedure TORRadioCheck.SetSpacing(const Value: integer);
begin
fSpacing := Value;
Invalidate;
end;
procedure TORRadioCheck.SetState(const Value: TCheckBoxState);
begin
fCheck.State := Value;
fRadio.Checked := fCheck.Checked;
end;
procedure TORRadioCheck.SetText(const Value: string);
begin
fLines.Text := Value;
Resize;
end;
procedure TORRadioCheck.SetTransparent(const Value: boolean);
begin
if (fTransparent <> Value) then begin
fTransparent := Value;
if Value then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];
end;
Invalidate;
end;
procedure TORRadioCheck.SetWordWrap(const Value: boolean);
begin
if (fWordWrap <> Value) then begin
fWordWrap := Value;
end;
Resize;
end;
procedure TORRadioCheck.SetWrapByChar(const Value: boolean);
begin
fWrapByChar := Value;
Resize;
end;
procedure TORRadioCheck.SyncAllowAllUnchecked;
var
i: integer;
cb: TORRadioCheck;
begin
if (assigned(Parent) and (GroupIndex <> 0)) then
begin
for i := 0 to Parent.ControlCount - 1 do
begin
if (Parent.Controls[i] is TORRadioCheck) then
begin
cb := TORRadioCheck(Parent.Controls[i]);
if ((cb <> Self) and (cb.GroupIndex = GroupIndex)) then
cb.FAllowAllUnchecked := FAllowAllUnchecked;
end;
end;
end;
end;
procedure TORRadioCheck.TextToCanvas(y: integer; s: string);
begin
if assigned(Canvas) then begin
case Alignment of // x position based on alignment property of control
taLeftJustify: Canvas.TextOut(IconSize + fSpacing + Margins.Left, y, s);
taRightJustify: Canvas.TextOut(IconSize + fSpacing + (Width - Margins.Right - Canvas.TextWidth(s)), y, s);
taCenter: Canvas.TextOut(IconSize + fSpacing + ((Width div 2) - Margins.Right - (Canvas.TextWidth(s) div 2)), y, s);
end;
end;
end;
end.