lazarus-src-0.9.30.4 0.9.30.4-6 / usr / lib / lazarus / 0.9.30.4 / lcl / arrow.pp

This file is indexed.

/usr/lib/lazarus/0.9.30.4/lcl/arrow.pp is in lazarus-src-0.9.30.4 0.9.30.4-6.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
{
 /***************************************************************************
                               Arrow.pp
                             -------------------
                             Component Library Calendar Component
                   Initial Revision  : Wed Dec 05 2001

 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{
@abstract(Arrow component)
@author(Shane Miller)
@created(05 Dev 2001)
}
unit Arrow;

{$mode objfpc}{$H+}

interface

uses
  Types, SysUtils, Classes, LCLType, Controls;
  
type

  TArrowType = (atUp, atDown, atLeft, atRight);
  TShadowType = (stNone, stIn, stOut, stEtchedIn, stEtchedOut);

  { TArrow }

  TArrow = class(TCustomControl)
  private
    FArrowType : TArrowType;
    FShadowType : TShadowType;
    function GetShadowType: TShadowType;
    procedure SetShadowType(const AValue: TShadowType);
    function GetArrowType: TArrowType;
    procedure SetArrowType(const AValue: TArrowType);
    procedure SetProps;
  protected
    class procedure WSRegisterClass; override;
    procedure Paint; override;
    class function GetControlClassDefaultSize: TSize; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;
    procedure InitializeWnd; override;
  published
    property Align;
    property Anchors;
    property ArrowType: TArrowType read GetArrowType write SetArrowType default atLeft;
    property BorderSpacing;
    property ShadowType: TShadowType read fShadowType write SetShadowType default stEtchedIn;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnChangeBounds;
    property OnResize;
    property OnContextPopup;
    property PopupMenu;
  end;
  
procedure Register;
  
implementation

uses
  InterfaceBase, WSArrow;

procedure Register;
begin
  RegisterComponents('Misc',[TArrow]);
end;

{ TArrow }

constructor TArrow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csDoubleClicks];
  fCompStyle := csArrow;
  fArrowType := atLeft;
  fShadowType := stEtchedIn;
  with GetControlClassDefaultSize do
    SetInitialBounds(0, 0, CX, CY);
end;

procedure TArrow.Loaded;
begin
  inherited Loaded;
  SetProps;
end;

procedure TArrow.Paint;
begin
  TWSArrowClass(WidgetSetClass).DrawArrow(Self, Canvas);
  inherited Paint;
end;

class function TArrow.GetControlClassDefaultSize: TSize;
begin
  Result.CX := 10;
  Result.CY := 10;
end;

procedure TArrow.InitializeWnd;
begin
  inherited InitializeWnd;
  SetProps;
end;

function TArrow.GetArrowType: TArrowType;
begin
  Result := FArrowType;
end;

procedure TArrow.SetArrowType(const AValue: TArrowType);
begin
  fArrowType := AValue;
  SetProps;
end;

function TArrow.GetShadowType: TShadowType;
begin
  Result := FShadowType;
end;

procedure TArrow.SetProps;
begin
  if HandleAllocated and (not (csLoading in ComponentState)) then
    TWSArrowClass(WidgetSetClass).SetType(Self, FArrowType, FShadowType);
end;

class procedure TArrow.WSRegisterClass;
begin
  inherited WSRegisterClass;
  RegisterArrow;
end;

procedure TArrow.SetShadowType(const AValue: TShadowType);
begin
  FShadowType := aValue;
  SetProps;
end;

end.

APT Browse - Built by Thomas Orozco.