Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kolekce/d345/JWTOOL.ZIP/jwtool/JwRotPan.pas

Pascal/Delphi Source File | 2001-09-29 | 6.9 KB | 244 lines

unit JwRotPan;

//  Version History
//     Num     Date        Notes
//     1.00  ???????   Initial Release

//  Created By:
//    Joseph Wilcock
//    [e-mail]
//    http://msnhomepages.talkcity.com/RedmondAve/coockoo/

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
     Forms, Graphics, Stdctrls, Extctrls, JwRtFsh;

type
  TJwRotatePanel = class(TPanel)
    private
      { Private fields of TJwRotatePanel }
      FApiFont: TApiFontRec;
      FOffsetLeft: LongInt;
      FOffsetTop: LongInt;
      FOffsetRight: LongInt;
      FOffsetBottom: LongInt;

      { Private methods of TJwRotatePanel }
    protected
      { Protected fields of TJwRotatePanel }

      { Protected methods of TJwRotatePanel }
      procedure Loaded; override;
      procedure Paint; override;

    public
      { Public fields and properties of TJwRotatePanel }

      { Public methods of TJwRotatePanel }
      constructor Create(AOwner: TComponent); override;
      destructor Destroy; override;

      Procedure OnChangeFont( Sender: TObject );
      Procedure SetApiFont( Value: TApiFontRec );
      Procedure SetLeftOffset( Value: LongInt );
      Procedure SetTopOffset( Value: LongInt );
      Procedure SetRightOffset( Value: LongInt );
      Procedure SetBottomOffset( Value: LongInt );
      procedure DoDrawText(var Rect: TRect; Flags: Word);
    published
      { Published properties of TJwRotatePanel }
      property ApiFont: TApiFontRec Read FApiFont Write SetApiFont;
      Property OffsetLeft: LongInt Read FOffsetLeft Write SetLeftOffset
        Default 0;
      Property OffsetTop: LongInt Read FOffsetTop Write SetTopOffset
        Default 0;
      Property OffsetRight: LongInt Read FOffsetRight Write SetRightOffset
        Default 0;
      Property OffsetBottom: LongInt Read FOffsetBottom Write SetBottomOffset
        Default 0;
      Property Anchors;
      property OnClick;
      property OnDblClick;
      property OnDragDrop;
      property OnEnter;
      property OnExit;
      property OnKeyDown;
      property OnKeyPress;
      property OnKeyUp;
      property OnMouseDown;
      property OnMouseMove;
      property OnMouseUp;
    end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('JwTools', [TJwRotatePanel]);
end;

constructor TJwRotatePanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FApiFont := TApiFontRec.Create;
  FApiFont.OnChange := OnChangeFont;
  FOffsetLeft := 0;
  FOffsetTop := 0;
  FOffsetRight := 0;
  FOffsetBottom := 0;
end;

destructor TJwRotatePanel.Destroy;
begin
  inherited Destroy;
end;

Procedure TJwRotatePanel.SetApiFont( Value: TApiFontRec );
begin
  FApiFont.Assign( Value );
  FApiFont.OnChange := OnChangeFont;
  Invalidate;
end;

procedure TJwRotatePanel.Loaded;
begin
  inherited Loaded;
end;

procedure TJwRotatePanel.Paint;
var
  Rect: TRect;
  TopColor, BottomColor: TColor;
  Text: array[0..255] of Char;
  FontHeight: Integer;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;

begin
  Rect := GetClientRect;
  if BevelOuter <> bvNone then
  begin
    AdjustColors(BevelOuter);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  if BevelInner <> bvNone then
  begin
    AdjustColors(BevelInner);
    Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  end;
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(Rect);
    Brush.Style := bsClear;
    Font := Self.Font;
    FontHeight := TextHeight('W');

    Rect := ClientRect;
    Rect.Left := Rect.Left + FOffsetLeft;
    Rect.Top := Rect.Top + FOffsetTop;
    Rect.Right := Rect.Right - FOffsetRight;
    Rect.Bottom := Rect.Bottom - FOffsetBottom;
    {StrPCopy(Text, Caption);
    DoDrawText(Handle, Text, StrLen(Text), Rect, (DT_EXPANDTABS or
      DT_VCENTER) or Alignments[Alignment]);}
    DoDrawText( Rect, (DT_EXPANDTABS or DT_VCENTER) or Alignments[Alignment] );
  end;
end;

procedure TJwRotatePanel.DoDrawText(var Rect: TRect; Flags: Word);
var
  Text: array[0..255] of Char;
  TmpStr: array[0..255] of Char;
begin
  GetTextBuf(Text, SizeOf(Text));
  if (Flags and DT_CALCRECT <> 0) and ((Text[0] = #0) and
    (Text[0] = '&') and (Text[1] = #0)) then StrCopy(Text, ' ');
  Flags := Flags or DT_NOPREFIX;

  {Right here is where we break ranks with the old code.  We want to change the font
  to have the properties that WE set.  We'll do this in a case statement so that
  changes to the API Wont ruin our code.}

  with FApiFont do begin
      if Escapement > 0 then
        Flags := DT_NOCLIP;
      StrPCopy( TmpStr, FaceName );
      Canvas.Font.Color := OverFontColor;
      Canvas.Font.Handle := CreateFont(   FontHeight,  {Height}
                                           FontWidth,  {Width}
                                          Escapement,  {Escapement}
                                         Orientation,  {Orientation}
                                ApiFontWeight,          {Weight}
                                              Italic,  {Italic}
                                           Underline,  {Underline}
                                           StrikeOut,  {StrikeOut}
                                ApiFontCharSet,         {CharSet}
                                ApiFontOutPrecision,    {OutputPrecision}
                                ApiFontClipPrecision,   {ClipPrecision}
                                ApiFontQuality,         {Quality}
                                ApiFontPitchAndFamily,  {PitchAndFamily}
                                               TmpStr );{FaceName}
  end; {end of with TmpFont}


  {Canvas.Font := Font;}
  if not Enabled then Canvas.Font.Color := clGrayText;
  DrawText(Canvas.Handle, Text, StrLen(Text), Rect, Flags);
end;

Procedure TJwRotatePanel.OnChangeFont( Sender: TObject );
begin
  InValidate;
end;

Procedure TJwRotatePanel.SetLeftOffset( Value: LongInt );
begin
  if FOffsetLeft <> Value then
    begin
      FOffsetLeft := Value;
      InValidate;
    end;
end;

Procedure TJwRotatePanel.SetTopOffset( Value: LongInt );
begin
  if FOffsetTop <> Value then
    begin
      FOffsetTop := Value;
      InValidate;
    end;
end;

Procedure TJwRotatePanel.SetRightOffset( Value: LongInt );
begin
  if FOffsetRight <> Value then
    begin
      FOffsetRight := Value;
      InValidate;
    end;
end;

Procedure TJwRotatePanel.SetBottomOffset( Value: LongInt );
begin
  if FOffsetBottom <> Value then
    begin
      FOffsetBottom := Value;
      InValidate;
    end;
end;

end.