{*********************************************************} {* OVCRLBL.PAS 4.06 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Orpheus *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} {$I OVC.INC} {$B-} {Complete Boolean Evaluation} {$I+} {Input/Output-Checking} {$P+} {Open Parameters} {$T-} {Typed @ Operator} {.W-} {Windows Stack Frame} {$X+} {Extended Syntax} unit ovcrlbl; {-Rotated label component} interface uses {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF} Classes, Controls, Graphics, SysUtils, OvcBase, OvcMisc; type TOvcCustomRotatedLabel = class(TOvcGraphicControl) {.Z+} protected {private} {property instance variables} FAlignment : TAlignment; FAutoSize : Boolean; FCaption : string; FFontAngle : Integer; FOriginX : Integer; FOriginY : Integer; FShadowColor : TColor; {color for text shadowing} FShadowedText : Boolean; {true to draw shadowed text} {internal variables} rlBusy : Boolean; {property methods} function GetTransparent : Boolean; procedure SetAlignment(Value : TAlignment); procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF} procedure SetCaption(const Value : string); procedure SetOriginX(Value : Integer); procedure SetOriginY(Value : Integer); procedure SetShadowColor(const Value : TColor); procedure SetShadowedText(Value : Boolean); procedure SetTransparent(Value : Boolean); procedure SetFontAngle(Value : Integer); {internal methods} procedure lblAdjustSize; {-adjust horizontal and/or vertical size of control} procedure lblDrawText(var R : TRect; Flags : Word); {-draw the label text} {VCL message handling methods} procedure CMFontChanged(var Msg : TMessage); message CM_FONTCHANGED; procedure CMTextChanged(var Mes : TMessage); message CM_TEXTCHANGED; protected procedure Loaded; override; procedure Paint; override; procedure SetName(const NewName : TComponentName); override; {.Z-} property Alignment : TAlignment read FAlignment write SetAlignment; property AutoSize : Boolean read FAutoSize write SetAutoSize; property Caption : string read FCaption write SetCaption; property FontAngle : Integer read FFontAngle write SetFontAngle; property OriginX : Integer read FOriginX write SetOriginX; property OriginY : Integer read FOriginY write SetOriginY; property ShadowColor : TColor read FShadowColor write SetShadowColor; property ShadowedText : Boolean read FShadowedText write SetShadowedText; property Transparent : Boolean read GetTransparent write SetTransparent; public {.Z+} constructor Create(AOwner: TComponent); override; {.Z-} {public properties} property Canvas; end; TOvcRotatedLabel = class(TOvcCustomRotatedLabel) published {$IFDEF VERSION4} property Anchors; property Constraints; property DragKind; {$ENDIF} property Align; property Alignment default taLeftJustify; property AutoSize; property Caption; property Color; property DragCursor; property DragMode; property Enabled; property Font; property FontAngle default 0; property Height default 20; property OriginX default 0; property OriginY default 0; property ParentColor; {property ParentFont;} property ParentShowHint; property PopupMenu; property ShadowColor default clBtnShadow; property ShadowedText; property ShowHint; property Transparent default False; property Visible; {events} property OnClick; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnStartDrag; end; implementation {*** TOvcCustomRotatedLabel ***} procedure TOvcCustomRotatedLabel.CMFontChanged(var Msg : TMessage); var TM : TTextMetric; begin inherited; if csLoading in ComponentState then Exit; if FFontAngle <> 0 then begin {check if the current font can be rotated} Canvas.Font := Self.Font; GetTextMetrics(Canvas.Handle, TM); if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then {force zero font angle} FontAngle := 0; end; lblAdjustSize; end; procedure TOvcCustomRotatedLabel.CMTextChanged(var Mes : TMessage); begin lblAdjustSize; end; constructor TOvcCustomRotatedLabel.Create(AOwner : TComponent); begin inherited Create(AOwner); ControlStyle := ControlStyle + [csReplicatable, csOpaque]; {default property values} FAlignment := taLeftJustify; FFontAngle := 0; FOriginX := 0; FOriginY := 0; FShadowColor := clBtnShadow; FShadowedText := False; {$IFDEF MSWINDOWS} Font.Name := 'Arial'; {$ELSE} Font.Name := 'default'; {$ENDIF} Height := 20; Width := 130; if csDesigning in ComponentState then lblAdjustSize; end; function TOvcCustomRotatedLabel.GetTransparent : Boolean; begin Result := not (csOpaque in ControlStyle); end; procedure TOvcCustomRotatedLabel.lblAdjustSize; {-adjust horizontal and/or vertical size of control} var R : TRect; W, H, X, Y : Integer; begin if rlBusy then {avoid reentrance} Exit; rlBusy := True; try if not (csLoading in ComponentState) and AutoSize then begin R := ClientRect; Canvas.Font := Font; W := Canvas.TextWidth(Caption); H := Canvas.TextHeight(Caption); if FFontAngle <> 0 then begin {adjust height and width as necessary} {width (X) of text at new angle} X := Round(W * Cos(FFontAngle*Pi/180)); {height (y) of text at new angle} Y := Round(W * Sin(FFontAngle*Pi/180)); R.Bottom := Abs(Y) + 2*H; R.Right := Abs(X) + 2*H; if X < 0 then FOriginX := R.Right-H else FOriginX := H; if Y < 0 then FOriginY := H else begin if X < 0 then FOriginY := R.Bottom - H else FOriginY := R.Bottom - H - H div 2; end; end else begin FOriginX := 0; FOriginY := 0; R.Right := W; R.Bottom := H; end; SetBounds(Left, Top, R.Right, R.Bottom); end; finally rlBusy := False; end; end; procedure TOvcCustomRotatedLabel.lblDrawText(var R : TRect; Flags : Word); {-paint the controls display or calculate a TRect to fit text} var HoldColor : TColor; T : string; XO, YO : Integer; A : Integer; Buf : array[0..255] of Char; {$IFDEF LCL} FontHand : hFont; {$ENDIF} begin T := Caption; if (Flags and DT_CALCRECT <> 0) and (T = '') then T := ' '; Flags := Flags or DT_NOPREFIX; {use our font} Canvas.Font := Font; {create the rotated font} if FFontAngle <> 0 then {$IFNDEF LCL} Canvas.Font.Handle := CreateRotatedFont(Font, FFontAngle); {$ELSE} //Workaround for now - Qt widgetset not setting Handle? FontHand := CreateRotatedFont(Font, FFontAngle); {$ENDIF} {force disabled text color, if not enabled} if not Enabled then Canvas.Font.Color := clGrayText; {draw the text} StrPLCopy(Buf, T, 255); if FFontAngle = 0 then begin {draw shadow first, if selected} if FShadowedText then begin HoldColor := Canvas.Font.Color; Canvas.Font.Color := FShadowColor; if not Transparent then begin SetBkMode(Canvas.Handle, OPAQUE); Canvas.Brush.Color := Color; end; OffsetRect(R, +2, +1); DrawText(Canvas.Handle, @Buf, -1, R, Flags); Canvas.Font.Color := HoldColor; {$IFNDEF LCL} SetBkMode(Canvas.Handle, Windows.TRANSPARENT); {$ELSE} SetBkMode(Canvas.Handle, LclType.TRANSPARENT); {$ENDIF} OffsetRect(R, -2, -1); DrawText(Canvas.Handle, @Buf, -1, R, Flags); end else begin DrawText(Canvas.Handle, @Buf, -1, R, Flags) end; end else begin if FShadowedText then begin HoldColor := Canvas.Font.Color; Canvas.Font.Color := FShadowColor; if not Transparent then begin {$IFNDEF LCL} SetBkMode(Canvas.Handle, Windows.OPAQUE); {$ELSE} SetBkMode(Canvas.Handle, LclType.OPAQUE); {$ENDIF} Canvas.Brush.Color := Color; end; {calculate the shadow offset based on the quadrant the text is in} { | } { 1 -- X+2, Y+1} { 2 | 1 } { 2 -- X-1, Y-2} { -------+--------- } { 3 -- X+2, Y+1} { 3 | 4 } { 4 -- X-1, Y-2} { | } A := FFontAngle; if A < 0 then A := 360 + A; if A >= 270 then begin XO := 2; YO := 1; {Quad=4} end else if A >= 180 then begin XO := 2; YO := 1; {Quad=3} end else if A >= 90 then begin XO := 2; YO := 1; {Quad=2} end else begin XO := 2; YO := 1; {Quad=1} end; {$IFDEF LCL} SelectObject(Canvas.Handle, FontHand); {$ENDIF} ExtTextOut(Canvas.Handle, OriginX+XO, OriginY+YO, ETO_CLIPPED, @R, Buf, StrLen(Buf), nil); Canvas.Font.Color := HoldColor; {$IFNDEF LCL} SetBkMode(Canvas.Handle, Windows.TRANSPARENT); {$ELSE} SetBkMode(Canvas.Handle, LclType.TRANSPARENT); {$ENDIF} {$IFDEF LCL} SelectObject(Canvas.Handle, FontHand); {$ENDIF} ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED, @R, Buf, StrLen(Buf), nil); end else begin {$IFDEF LCL} SelectObject(Canvas.Handle, FontHand); {$ENDIF} ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED, @R, Buf, StrLen(Buf), nil); end; end; end; procedure TOvcCustomRotatedLabel.Loaded; begin inherited Loaded; lblAdjustSize; end; procedure TOvcCustomRotatedLabel.Paint; const Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER); var R : TRect; begin R := ClientRect; with Canvas do begin if not Transparent then begin Brush.Color := Self.Color; Brush.Style := bsSolid; FillRect(R); end; Brush.Style := bsClear; lblDrawText(R, Alignments[FAlignment]) end; end; procedure TOvcCustomRotatedLabel.SetAlignment(Value : TAlignment); begin if FAlignment <> Value then begin FAlignment := Value; Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetAutoSize(Value : Boolean); begin if Value <> FAutoSize then begin FAutoSize := Value; lblAdjustSize; end; end; procedure TOvcCustomRotatedLabel.SetCaption(const Value : string); begin if Value <> FCaption then begin FCaption := Value; lblAdjustSize; Repaint; end; end; procedure TOvcCustomRotatedLabel.SetOriginX(Value : Integer); begin if Value <> FOriginX then begin FOriginX := Value; Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetOriginY(Value : Integer); begin if Value <> FOriginY then begin FOriginY := Value; Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetShadowColor(const Value : TColor); begin if Value <> FShadowColor then begin FShadowColor := Value; invalidate; end; end; procedure TOvcCustomRotatedLabel.SetShadowedText(Value : Boolean); begin if Value <> FShadowedText then begin FShadowedText := Value; Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetTransparent(Value : Boolean); begin if Transparent <> Value then begin if Value then ControlStyle := ControlStyle - [csOpaque] else ControlStyle := ControlStyle + [csOpaque]; Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetFontAngle(Value : Integer); var Neg : Integer; TM : TTextMetric; begin if Value <> FFontAngle then begin {check if the current font can be rotated} if not (csLoading in ComponentState) then begin if Value <> 0 then begin Canvas.Font := Font; GetTextMetrics(Canvas.Handle, TM); if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then {force true-type font} {$IFDEF MSWINDOWS} Font.Name := 'Arial'; {$ENDIF} end; end; if Value < 0 then Neg := -1 else Neg := 1; FFontAngle := (Abs(Value) mod 360) * Neg; lblAdjustSize; {repaint with new font} Invalidate; end; end; procedure TOvcCustomRotatedLabel.SetName(const NewName : TComponentName); begin inherited SetName(NewName); if (csDesigning in ComponentState) and (FCaption = '') then FCaption := Self.Name; end; end.