speedbar.pas

RX Library contains a large number of components, objects and routines for Borland Delphi with full

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function HasParent: Boolean; override;
{$IFDEF WIN32}
    function GetParentComponent: TComponent; override;
{$ENDIF}
    procedure Clear;
    procedure RemoveItem(Item: TSpeedItem);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TSpeedItem read Get write Put; default;
    property List: TList read FList; { for internal use only }
    property SpeedBar: TSpeedBar read FParent write SetSpeedbar stored False;
  published
    property Caption: string read GetTitle write SetTitle;
    property Index: Integer read GetIndex write SetIndex stored False;
  end;

{ TBtnControl }

  TBtnControl = class(TCustomControl)
  private
    FImage: TButtonImage;
    FSpacing, FMargin: Integer;
    FLayout: TButtonLayout;
{$IFDEF WIN32}
    FImageIndex: Integer;
    FImages: TImageList;
{$ENDIF}
    function GetCaption: TCaption;
    function GetGlyph: TBitmap;
    function GetNumGlyphs: TRxNumGlyphs;
    function GetWordWrap: Boolean;
    function GetAlignment: TAlignment;
    procedure SetAlignment(Value: TAlignment);
    procedure SetCaption(const Value: TCaption);
    procedure SetNumGlyphs(Value: TRxNumGlyphs);
    procedure SetGlyph(Value: TBitmap);
    procedure SetWordWrap(Value: Boolean);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AssignSpeedItem(Item: TSpeedItem);
    procedure Activate(Rect: TRect);
    procedure ReleaseHandle;
    property Alignment: TAlignment read GetAlignment write SetAlignment;
    property Caption: TCaption read GetCaption write SetCaption;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs;
    property Spacing: Integer read FSpacing write FSpacing;
{$IFDEF WIN32}
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property Images: TImageList read FImages write FImages;
{$ENDIF}
    property Margin: Integer read FMargin write FMargin;
    property Layout: TButtonLayout read FLayout write FLayout;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap;
    property Font;
  end;

const
{ Values for WParam for CM_SPEEDBARCHANGED message }
  SBR_CHANGED        = 0; { change buttons properties  }
  SBR_DESTROYED      = 1; { destroy speedbar           }
  SBR_BTNSELECT      = 2; { select button in speedbar  }
  SBR_BTNSIZECHANGED = 3; { button size changed        }

{ Utility routines for Speedbar Editors }

function FindSpeedBar(const Pos: TPoint): TSpeedBar;
procedure DrawCellButton(Grid: TDrawGrid; R: TRect; Item: TSpeedItem;
  Image: TButtonImage {$IFDEF RX_D4}; ARightToLeft: Boolean = False {$ENDIF});
function NewSpeedSection(ASpeedbar: TSpeedBar; const ACaption: string): Integer;
function NewSpeedItem(AOwner: TComponent; ASpeedbar: TSpeedBar; Section: Integer;
  const AName: string): TSpeedItem;

implementation

uses Dialogs, MaxMin, VCLUtils, AppUtils, rxStrUtils, Consts, RxConst, SbSetup;

{ SpeedBar exceptions }
{$IFDEF RX_D3}
resourcestring
{$ELSE}
const
{$ENDIF}
  SAutoSpeedbarMode = 'Cannot set this property value while Position is bpAuto';

const
  DefaultButtonSize: TPoint = (X: DefButtonWidth; Y: DefButtonHeight);
  DragFrameWidth = 3;
  StartDragOffset = 4;
  Registered: Boolean = False;

const
  Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

{ TSpeedbarSection }

constructor TSpeedbarSection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList := TList.Create;
  FTitle := EmptyStr;
end;

destructor TSpeedbarSection.Destroy;
begin
  Clear;
  if FParent <> nil then FParent.DeleteSection(Index);
  //if (FTitle <> nil) and (FTitle^ <> '') then Dispose(FTitle);
  FTitle := SysUtils.EmptyStr;
  FList.Free;
  inherited Destroy;
end;

procedure TSpeedbarSection.Clear;
begin
  while FList.Count > 0 do begin
    TSpeedItem(FList[0]).Free;
    FList.Delete(0);
  end;
end;

function TSpeedbarSection.Get(Index: Integer): TSpeedItem;
begin
  Result := TSpeedItem(FList[Index]);
end;

procedure TSpeedbarSection.Put(Index: Integer; Item: TSpeedItem);
begin
  FList[Index] := Item;
end;

function TSpeedbarSection.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TSpeedbarSection.GetIndex: Integer;
begin
  if FParent <> nil then Result := FParent.FSections.IndexOf(Self)
  else Result := -1;
end;

procedure TSpeedbarSection.SetIndex(Value: Integer);
var
  CurIndex, Count: Integer;
begin
  CurIndex := GetIndex;
  if CurIndex >= 0 then begin
    Count := FParent.FSections.Count;
    if Value < 0 then Value := 0;
    if Value >= Count then Value := Count - 1;
    if Value <> CurIndex then begin
      FParent.FSections.Delete(CurIndex);
      FParent.FSections.Insert(Value, Self);
    end;
  end;
end;

function TSpeedbarSection.HasParent: Boolean;
begin
  Result := True;
end;

procedure TSpeedbarSection.SetSpeedbar(Value: TSpeedBar);
var
  CurIndex: Integer;
begin
  CurIndex := GetIndex;
  if FParent <> nil then FParent.DeleteSection(Index);
  if Value <> nil then Value.AppendSection(Self);
  if CurIndex >= 0 then Index := CurIndex;
end;

{$IFDEF WIN32}

function TSpeedbarSection.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

procedure TSpeedbarSection.SetParentComponent(Value: TComponent);
begin
  SpeedBar := Value as TSpeedBar;
end;

{$ELSE}

procedure TSpeedbarSection.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TSpeedBar then SpeedBar := TSpeedBar(Reader.Parent);
end;

{$ENDIF}

procedure TSpeedbarSection.RemoveItem(Item: TSpeedItem);
var
  I: Integer;
begin
  I := FList.IndexOf(Item);
  if I >= 0 then begin
    Item.FButton.Parent := nil;
    Item.FParent := nil;
    Item.FSection := -1;
    FList.Delete(I);
  end;
end;

procedure TSpeedbarSection.ValidateCaption(const NewCaption: string);
var
  I: Integer;
begin
  if FParent <> nil then begin
    I := FParent.SearchSection(NewCaption);
    if (I <> Index) and (I >= 0) then
      raise ESpeedbarError.Create(ResStr(SDuplicateString));
  end;
end;

procedure TSpeedbarSection.SetTitle(const Value: string);
begin
  if not (csLoading in ComponentState) then ValidateCaption(Value);
  FTitle := Value;
end;

function TSpeedbarSection.GetTitle: string;
begin
  Result := FTitle;
end;

{ TSpeedbarButton }

type
  TSpeedbarButton = class(TRxSpeedButton)
  private
    FItem: TSpeedItem;
    FBtn: TBtnControl;
    procedure InvalidateGlyph;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
  protected
    procedure WndProc(var Message: TMessage); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure PaintGlyph(Canvas: TCanvas; ARect: TRect; AState: TRxButtonState;
      DrawMark: Boolean); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  end;

constructor TSpeedbarButton.Create(AOwner: TComponent);
begin
  FItem := TSpeedItem(AOwner);
  { Ensure FItem is assigned before inherited Create }
  inherited Create(AOwner);
  Visible := False;
  Style := bsNew;
  ParentShowHint := True;
  ParentFont := True;
end;

destructor TSpeedbarButton.Destroy;
begin
  FBtn.Free;
  inherited Destroy;
end;

procedure TSpeedbarButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (FItem.Speedbar <> nil) then begin
    case FItem.Speedbar.Orientation of
      boHorizontal: ATop := Max(FItem.Speedbar.FOffset.Y, ATop);
      boVertical: ALeft := Max(FItem.Speedbar.FOffset.X, ALeft);
    end;
  end;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TSpeedbarButton.CMVisibleChanged(var Message: TMessage);
begin
  if Visible then ControlStyle := ControlStyle + [csOpaque]
  else ControlStyle := ControlStyle - [csOpaque];
  inherited;
end;

procedure TSpeedbarButton.WndProc(var Message: TMessage);
begin
  if FItem.FEditing and (csDesigning in ComponentState) and
    (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
  begin
    if (Message.Msg = WM_LBUTTONDOWN) and not Visible then
      inherited WndProc(Message)
    else Dispatch(Message);
  end
  else inherited WndProc(Message);
end;

procedure TSpeedbarButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  P: TPoint;
begin
  if FItem.FEditing and Visible and (Button = mbLeft) and
    (FItem.Speedbar <> nil) then
  begin
    P := ClientToScreen(Point(FItem.Speedbar.BtnWidth {div 2},
      FItem.Speedbar.BtnHeight {div 2}));
    X := P.X; Y := P.Y;
    if FBtn = nil then begin
      SetCursorPos(X, Y);
      FBtn := TBtnControl.Create(Self);
      FBtn.AssignSpeedItem(FItem);
    end;
    BringToFront;
  end
  else inherited MouseDown(Button, Shift, X, Y);
end;

procedure TSpeedbarButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  R: TRect;
begin
  if FItem.FEditing and (FBtn <> nil) then begin
    P := ClientToScreen(Point(X - (FBtn.Width {div 2}),
      Y - (FBtn.Height {div 2})));
    X := P.X; Y := P.Y;
    if FItem.SpeedBar <> nil then begin
      Visible := False;
      if (csDesigning in ComponentState) then begin
        R := BoundsRect;
        InvalidateRect(FItem.Speedbar.Handle, @R, True);
      end;
      P := FItem.SpeedBar.ScreenToClient(P);
      if PtInRect(FItem.SpeedBar.ClientRect, P) then begin
        FBtn.Activate(Bounds(X, Y, FBtn.Width, FBtn.Height));
      end
      else FBtn.ReleaseHandle;
    end;
  end
  else inherited MouseMove(Shift, X, Y);
end;

procedure TSpeedbarButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  P: TPoint;
begin
  if FItem.FEditing and (FBtn <> nil) then begin
    X := X - (FBtn.Width {div 2});
    Y := Y - (FBtn.Height {div 2});
    FBtn.Free;
    FBtn := nil;
    P := ClientToScreen(Point(X, Y));
    if FItem.SpeedBar <> nil then begin
      P := FItem.SpeedBar.ScreenToClient(P);
      if PtInRect(FItem.SpeedBar.ClientRect, P) then begin
        if not FItem.SpeedBar.AcceptDropItem(FItem, P.X, P.Y) then begin
          SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_CHANGED,
            Longint(FItem.Speedbar));
        end
        else begin
          SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_BTNSELECT,
            Longint(FItem));
          Invalidate;
        end;
      end
      else begin
        SendToBack;
        FItem.Visible := False;
        SendMessage(FItem.Speedbar.FEditWin, CM_SPEEDBARCHANGED, SBR_CHANGED,
          Longint(FItem.Speedbar));
      end;
    end;
  end
  else inherited MouseUp(Button, Shift, X, Y);
end;

procedure TSpeedbarButton.InvalidateGlyph;
begin
  TRxButtonGlyph(ButtonGlyph).Invalidate;
end;

procedure TSpeedbarButton.PaintGlyph(Canvas: TCanvas; ARect: TRect;
  AState: TRxButtonState; DrawMark: Boolean);
begin
{$IFDEF WIN32}
  if (FItem.Speedbar <> nil) then begin
    TRxButtonGlyph(ButtonGlyph).DrawEx(Canvas, ARect, Caption, Layout,
      Margin, Spacing, DrawMark, FItem.Speedbar.Images, FItem.FImageIndex,
      AState, {$IFDEF RX_D4} DrawTextBiDiModeFlags(Alignments[Alignment])
      {$ELSE} Alignments[Alignment] {$ENDIF});
  end else
{$ENDIF}
  inherited PaintGlyph(Canvas, ARect, AState, DrawMark);
end;

procedure TSpeedbarButton.Paint;
begin
  if Visible then inherited Paint;
end;

{ TSpeedItem }

constructor TSpeedItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButton := TSpeedbarButton.Create(Self);
  FButton.Visible := False;
  FButton.SetBounds(0, 0, DefaultButtonSize.X, DefaultButtonSize.Y);
  FCaption := EmptyStr;
  ShowHint := True;
  ParentShowHint := True;
  FVisible := False;
  FStored := True;
  FEnabled := True;
  FEditing := False;
  FParent := nil;
{$IFDEF WIN32}
  FImageIndex := -1;
{$ENDIF}
end;

destructor TSpeedItem.Destroy;
begin
  FVisible := False;
  if FParent <> nil then FParent.RemoveItem(Self);
  FButton.Free;
  //if (FCaption <> nil) and (FCaption^ <> '') then Dispose(FCaption);
  FCaption := EmptyStr;
  inherited Destroy;
end;