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 ORStaticText;

(*************************************************************************************************
OR Static Text control - Static Text control that adds multi-line capability;
mainly used to replace label controls that speech engines can't read.
**************************************************************************************************)

interface

uses
Windows, Messages, Graphics, Controls, ExtCtrls, StdCtrls, Classes, SysUtils;

type
{ TORStaticText component class }
TORStaticText = class(TPanel) // Does not accept controls
private
fLines: TStringList; // 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;

LargestTextWidth: integer;
LargestPixelWidth: integer;
LargestPixelHeight: integer;

procedure TextToCanvas(y: integer; s: string);
procedure SetMaxWidth(const Value: integer);
procedure SetWrapByChar(const Value: boolean);

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

function GetText: string; // read accessor for Text

procedure SetLines(const Value: TStringList); // 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);

procedure Paint; override; // draws the control on the canvas
procedure Resize; override;
public
property Caption;
property Displayed: TStringList read fDisplayed;
constructor Create(AOwner: TComponent); override; // constructor
destructor Destroy; override; // destructor
procedure PauseResize;
procedure ResumeResize;
published
property AutoSize;
property Text: string read GetText write SetText; // control text in a single line
property Lines: TStringList read fLines write SetLines; // user-formatted text; CRLF delimited
property Transparent: boolean read fTransparent write SetTransparent default True; // determines if the background is transparent
property VerticalSpace: integer read fVerticalSpace write SetVerticalSpace default 1; // number of vertical pixel spaces between items when using multi-line
property WordWrap: boolean read fWordWrap write SetWordWrap default True;
property MaxWidth: integer read fMaxWidth write SetMaxWidth default 0;
property WrapByChar: boolean read fWrapByChar write SetWrapByChar default False;
end;

implementation

uses
StrUtils, Math, Forms, System.UITypes, ORFn;

{ TORStaticText }

{==================================================================================================}
{ constructor Create - Create an instance of TORStaticText. }
{--------------------------------------------------------------------------------------------------}
{ AOwner: component responsible for creation/destruction of the component }
{==================================================================================================}
constructor TORStaticText.Create(AOwner: TComponent);
begin
inherited;

// initialize objects
fLines := TStringList.Create;
fDisplayed := TStringList.Create;

// set internal property values
fTransparent := True;
fVerticalSpace := 1;
AutoSize := False;
fWordWrap := True;
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;
Height := 1;
Width := 1;
ControlStyle := ControlStyle - [csAcceptsControls]; // should react like an edit, not like a panel
end;

{==================================================================================================}
{ destructor Destroy - destroy the instance of TORStatic }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
destructor TORStaticText.Destroy;
begin
// free up objects
if assigned(fLines) then fLines.Free;
if assigned(fDisplayed) then fDisplayed.Free;

inherited;
end;

{==================================================================================================}
{ procedure DoEnter - override of TWinControl DoEnter: fired when a control is entered }
{ Needed to repaint the control to show focus }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
procedure TORStaticText.DoEnter;
begin
Paint;
inherited;
end;

{==================================================================================================}
{ procedure DoExit - override of TWinControl DoExit: fired when a control is exited }
{ Needed to repaint the control to show loss of focus }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
procedure TORStaticText.DoExit;
begin
Paint;
inherited;
end;

{==================================================================================================}
{ function GetText - write accessor for Text property }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
function TORStaticText.GetText: string;
begin
Result := fLines.Text;
end;

{==================================================================================================}
{ procedure TextToCanvas - Draws the text on the canvas based on the current control properties }
{--------------------------------------------------------------------------------------------------}
{ y: y coordinate to start drawing the string }
{ s: string to be drawn on canvas }
{==================================================================================================}
procedure TORStaticText.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(Margins.Left, y, s);
taRightJustify: Canvas.TextOut((Width - Margins.Right - Canvas.TextWidth(s)), y, s);
taCenter: Canvas.TextOut(((Width div 2) - Margins.Right - (Canvas.TextWidth(s) div 2)), y, s);
end;
end;
end;

{==================================================================================================}
{ procedure Paint - override of TWinControl Paint }
{ Draws the control on the canvas }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
procedure TORStaticText.Paint;
var
r: TRect; // rectangle used to draw the border
i: integer; // loops
py: integer; // position y
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
{------------------}
{ 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
py := Margins.Top;
for i := 0 to (fDisplayed.Count - 1) do begin // loop through lines, determine if they need wrapped
//ExtTextOut(Canvas.Handle, Margins.Left, py, TextFlags, nil, fDisplayed[i], Length(fDisplayed[i]), nil);
TextToCanvas(py, fDisplayed[i]);
inc(py, LargestPixelHeight + VerticalSpace);
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 TORStaticText.PauseResize;
begin
fPauseResize := True;
end;

{==================================================================================================}
{ procedure Resize - override of TWinControl Resize }
{ Resizes the controls based on current property settings }
{--------------------------------------------------------------------------------------------------}
{==================================================================================================}
procedure TORStaticText.Resize;
var
i: integer;
TextWidth: integer;
TextHeight: integer;
sl: TStringList;
begin
inherited;
if fPauseResize then begin
ResizeRequested := True;
end else begin
if not Resizing then begin
Resizing := True;
try
LargestTextWidth := 0;
LargestPixelWidth := 0;
LargestPixelHeight := 0;
if fWordWrap and (fMaxWidth > 0) then begin // word handling is Word Wrap
for i := 0 to (fLines.Count - 1) do begin
if Trim(fLines[i]) <> '' then begin
TextWidth := Canvas.TextWidth(fLines[i]);
LargestTextWidth := Max(LargestTextWidth, TextWidth);
LargestPixelWidth := Max(LargestPixelWidth, (TextWidth div Length(fLines[i]) + 1));
TextHeight := Canvas.TextHeight(fLines[i]);
LargestPixelHeight := Max(LargestPixelHeight, TextHeight + 1);
end;
end;
if (fMaxWidth > 0) then begin
LargestTextWidth := Min(LargestTextWidth, fMaxWidth);
end;
for i := 0 to (fLines.Count - 1) do begin
if fWrapByChar then
sl := WrapTextByChar(fLines[i], fMaxWidth, Canvas, PreSeparatorChars, PostSeparatorChars)
else
sl := WrapTextByPixels(fLines[i], LargestTextWidth, Canvas, PreSeparatorChars, PostSeparatorChars);
fDisplayed.AddStrings(sl);
end;
end else begin // no word wrapping
fDisplayed.Text := fLines.Text;
end;

if AutoSize then begin
Width := LargestTextWidth * LargestPixelWidth + Margins.Left + Margins.Right;
Height := fDisplayed.Count * LargestPixelHeight + Margins.Top + Margins.Bottom;
end;
Invalidate;
finally
Resizing := False;
end;
end;
end;
end;

procedure TORStaticText.ResumeResize;
begin
fPauseResize := False;
if ResizeRequested then Resize;
end;

{==================================================================================================}
{ procedure SetLines - write accessor for Lines property }
{--------------------------------------------------------------------------------------------------}
{ Value: Lines' new value }
{==================================================================================================}
procedure TORStaticText.SetLines(const Value: TStringList);
begin
if (Value.Text <> fLines.Text) then begin
fLines.Text := Value.Text;
Resize;
end;
end;

{==================================================================================================}
{ procedure SetMultiLine - write accessor for MultiLine property }
{--------------------------------------------------------------------------------------------------}
{ Value: MultiLine's new value }
{==================================================================================================}
procedure TORStaticText.SetMaxWidth(const Value: integer);
begin
if (fMaxWidth <> Value) then begin
fMaxWidth := Value;
Resize;
end;
end;

{==================================================================================================}
{ procedure SetName - overwrite write accessor for Name property }
{--------------------------------------------------------------------------------------------------}
{ Value: New name for the component }
{==================================================================================================}
procedure TORStaticText.SetName(const Value: TComponentName);
begin
if (Name <> Value) then begin
inherited SetName(Value);
fLines.Text := Name;
end;
end;

{==================================================================================================}
{ procedure SetTransparent - write accessor for Transparent property }
{--------------------------------------------------------------------------------------------------}
{ Value: Transparent's new value }
{==================================================================================================}
procedure TORStaticText.SetText(const Value: string);
begin
if (Value <> fLines.Text) then begin
fLines.Text := Value;
Resize;
end;
end;

procedure TORStaticText.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 SetVerticalSpace - write accessor for VerticalSpace property }
{--------------------------------------------------------------------------------------------------}
{ Value: VerticalSpace's new value }
{==================================================================================================}
procedure TORStaticText.SetVerticalSpace(const Value: integer);
begin
if (fVerticalSpace <> Value) then begin
fVerticalSpace := Value;
Invalidate;
end;
end;

procedure TORStaticText.SetWordWrap(const Value: boolean);
begin
if (fWordWrap <> Value) then begin
fWordWrap := Value;
end;
Resize;
end;

procedure TORStaticText.SetWrapByChar(const Value: boolean);
begin
fWrapByChar := Value;
Resize;
end;

end.