sbedit.pas

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

    until FBar.SearchSection(S) < 0;
    I := NewSpeedSection(FBar, S);
    if I >= 0 then FBar.Sections[I].Name := UniqueName(FBar.Sections[I]);
    ActiveControl := SectionName;
    Designer.Modified;
  end;
end;

procedure TSpeedbarEditor.DelSectionClick(Sender: TObject);
var
  Sect: Integer;
  Item: TSpeedItem;
begin
  if CheckSpeedBar and ConfirmDelete then begin
    Sect := SectionList.Row;
    if (Sect >= 0) and (Sect < FBar.SectionCount) then begin
      Self.ValidateRename(FBar.Sections[Sect],
        FBar.Sections[Sect].Name, '');
      try
        while FBar.ItemsCount(Sect) > 0 do begin
          Item := FBar.Items(Sect, 0);
          if Item <> nil then begin
            OwnerForm.RemoveComponent(Item);
            Item.Free;
          end;
        end;
        FBar.RemoveSection(Sect);
      finally
        Designer.Modified;
      end;
    end;
  end;
end;

procedure TSpeedbarEditor.Copy;
var
  CompList: IDesignerSelections;
  Item: TSpeedItem;
begin
  CompList := CreateSelectionList;
  try
    Item := ItemByRow(ButtonsList.Row);
    if Item <> nil then begin
      Item.InvalidateItem;
      CompList.Add(Item);
      CopyComponents(OwnerForm, CompList);
      Item.UpdateSection;
    end;
  finally
    //CompList.Free;
  end;
end;

procedure TSpeedbarEditor.Paste;
var
  CompList: IDesignerSelections;
begin
  if CheckSpeedBar then begin
    CompList := CreateSelectionList;
    try
      FBar.OnAddItem := OnPasteItem;
      try
        PasteComponents(OwnerForm, FBar, CompList);
      finally
        FBar.OnAddItem := nil;
      end;
      UpdateData;
    finally
      //CompList.Free;
    end;
  end;
end;

procedure TSpeedbarEditor.Cut;
begin
  Copy;
  RemoveButtonClick(Self);
end;

procedure TSpeedbarEditor.OnPasteItem(Item: TObject);
begin
  if (Item <> nil) then begin
    if CheckSpeedBar and (Item is TSpeedItem) then begin
      TSpeedItem(Item).ASection := CurrentSection;
      TSpeedItem(Item).Visible := False;
    end
  end;
end;

procedure TSpeedbarEditor.AddButtonClick(Sender: TObject);
var
  I: Integer;
  Item: TSpeedItem;
begin
  I := CurrentSection;
  if I < 0 then Exit;
  Item := TSpeedItem.Create(OwnerForm);
  if Item <> nil then
    try
      FBar.AddItem(I, Item);
      Item.Name := UniqueName(Item);
      Designer.Modified;
      if (Sender <> nil) then ActivateInspector(#0);
    except
      Item.Free;
      raise;
    end
  else raise ESpeedbarError.CreateRes(srSBItemNotCreate);
end;

procedure TSpeedbarEditor.RemoveButtonClick(Sender: TObject);
var
  Item: TSpeedItem;
begin
  Item := ItemByRow(ButtonsList.Row);
  if Item <> nil then begin
    Self.ValidateRename(Item, Item.Name, '');
    OwnerForm.RemoveComponent(Item);
    Item.Free;
    Designer.Modified;
  end;
end;

procedure TSpeedbarEditor.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TSpeedbarEditor.UpBtnClick(Sender: TObject);
var
  I, Sect: Integer;
begin
  if CheckSpeedBar and FBar.FindItem(ItemByRow(ButtonsList.Row), Sect, I) then
  begin
    if I > 0 then begin
      FBar.Sections[Sect].List.Move(I, I - 1);
      Designer.Modified;
      ButtonsList.Invalidate;
      ButtonsList.Row := ButtonsList.Row - 1;
    end;
  end;
end;

procedure TSpeedbarEditor.DownBtnClick(Sender: TObject);
var
  I, Sect: Integer;
begin
  if CheckSpeedBar and FBar.FindItem(ItemByRow(ButtonsList.Row), Sect, I) then
  begin
    if I < FBar.ItemsCount(Sect) - 1 then begin
      FBar.Sections[Sect].List.Move(I, I + 1);
      Designer.Modified;
      ButtonsList.Invalidate;
      ButtonsList.Row := ButtonsList.Row + 1;
    end;
  end;
end;

procedure TSpeedbarEditor.CopyMenuClick(Sender: TObject);
begin
  Copy;
end;

procedure TSpeedbarEditor.PasteMenuClick(Sender: TObject);
begin
  Paste;
end;

procedure TSpeedbarEditor.CutMenuClick(Sender: TObject);
begin
  Cut;
end;

procedure TSpeedbarEditor.SectionNameExit(Sender: TObject);
var
  I: Integer;
begin
  if CheckSpeedBar and (FBar.SectionCount > 0) then begin
    I := CurrentSection;
    if I >= 0 then begin
      FBar.Sections[I].Caption := SectionName.Text;
      Designer.Modified;
    end;
  end;
end;

procedure TSpeedbarEditor.SectionListSelectCell(Sender: TObject; Col,
  Row: Longint; var CanSelect: Boolean);
begin
  CanSelect := False;
  if CheckSpeedBar and (Row < FBar.SectionCount) and (Row >= 0) then begin
    if FLocked = 0 then begin
      SetSection(Row);
      UpdateEnabled(ButtonsList.Row, Row);
      ButtonsList.Invalidate;
      SelectButton(Row, ItemBySectionRow(Row, ButtonsList.Row), False);
    end;
    CanSelect := True;
  end;
end;

procedure TSpeedbarEditor.SectionListDrawCell(Sender: TObject; Col,
  Row: Longint; Rect: TRect; State: TGridDrawState);
begin
  if CheckSpeedBar then begin
    if (Row < FBar.SectionCount) and (Row >= 0) then begin
      DrawCellText(Sender as TDrawGrid, Col, Row,
        FBar.Sections[Row].Caption, Rect, taLeftJustify, vaCenter
        {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
    end;
  end;
end;

procedure TSpeedbarEditor.SectionListKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN: if SectionByRow(SectionList.Row) <> nil then ActivateInspector(#0);
    VK_DELETE: DelSectionClick(Self);
    VK_INSERT, VK_ADD: NewSectionClick(Self);
    else Exit;
  end;
  Key := 0;
end;

procedure TSpeedbarEditor.ButtonsListKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_RETURN: if ItemByRow(ButtonsList.Row) <> nil then ActivateInspector(#0);
    VK_DELETE: RemoveButtonClick(Self);
    VK_INSERT, VK_ADD: AddButtonClick(Self);
    else Exit;
  end;
  Key := 0;
end;

procedure TSpeedbarEditor.ButtonsListDblClick(Sender: TObject);
type
  PParamData = ^TParamData;
  TParamData = record
    Flags: TParamFlags;
    ParamNameAndType: array[0..100] of Char;
  end;
const
{$IFDEF CBUILDER}
  sSender: string[7] = '*Sender';
{$ELSE}
  sSender: string[6] = 'Sender';
{$ENDIF}
  sObject: string[7] = 'TObject';
var
  Btn: TSpeedItem;
  I, Num: Integer;
  MethodName: string;
  Method: TMethod;
  TypeData: PTypeData;
  ParamData: PParamData;
  PropInfo: PPropInfo;
  Candidates: TPropInfoList;
begin
  Btn := ItemByRow(ButtonsList.Row);
  if Btn = nil then Exit;
  Candidates := TPropInfoList.Create(Btn, [tkMethod]);
  try
    for I := Candidates.Count - 1 downto 0 do begin
      PropInfo := Candidates[I];
      if CompareText(PropInfo^.Name, 'OnClick') = 0 then begin
        Method := GetMethodProp(Btn, PropInfo);
        MethodName := TFormDesigner(Designer).GetMethodName(Method);
        if MethodName = '' then begin
          MethodName := Btn.Name + 'Click';
          Num := 0;
          while TFormDesigner(Designer).MethodExists(MethodName) do begin
            MethodName := Btn.Name + 'Click' + IntToStr(Num);
            Inc(Num);
          end;
          TypeData := AllocMem(SizeOf(TTypeData));
          try
            TypeData^.MethodKind := mkProcedure;
            TypeData^.ParamCount := 1;
            ParamData := PParamData(@TypeData^.ParamList);
            with ParamData^ do begin
              Flags := [];
              ParamNameAndType[0] := Char(Length(sSender));
              Move(sSender[1], ParamNameAndType[1], Length(sSender));
              ParamNameAndType[Length(sSender) + 1] := char(Length(sObject));
              Move(sObject[1], ParamNameAndType[Length(sSender) + 2],
                Length(sObject));
            end;
            Method := TFormDesigner(Designer).CreateMethod(MethodName, TypeData);
            Method.Data := OwnerForm;
          finally
            FreeMem(TypeData, SizeOf(TTypeData));
          end;
          Btn.OnClick := TNotifyEvent(Method);
          Designer.Modified;
        end;
        if (MethodName <> '') and TFormDesigner(Designer).MethodExists(MethodName) then
          TFormDesigner(Designer).ShowMethod(MethodName);
        Break;
      end;
    end;
  finally
    Candidates.Free;
  end;
end;

procedure TSpeedbarEditor.ButtonsListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Item: TSpeedItem;
begin
  if (X < FBar.BtnWidth + 2) and (Button = mbLeft) then
  begin
    Item := ItemByRow(ButtonsList.Row);
    if Item <> nil then begin
      FDrag := True;
      if Item.Visible then FDragItem := nil
      else begin
        FDragItem := Item;
        if FButton = nil then begin
          FButton := TBtnControl.Create(Self);
          TBtnControl(FButton).AssignSpeedItem(Item);
        end;
      end;
    end;
  end;
end;

procedure TSpeedbarEditor.ButtonsListMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if FDrag and (FButton <> nil) and (FDragItem <> nil) then begin
    P := (Sender as TControl).ClientToScreen(Point(X, Y));
    X := P.X - (FButton.Width {div 2});
    Y := P.Y - (FButton.Height {div 2});
    FButton.Activate(Bounds(X, Y, FBar.BtnWidth, FBar.BtnHeight));
  end
  else if FDrag then SetCursor(Screen.Cursors[crNoDrop]);
end;

procedure TSpeedbarEditor.ButtonsListMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if FDrag and (Button = mbLeft) then
  try
    if (FDragItem <> nil) and (FButton <> nil) then begin
      Dec(X, FButton.Width {div 2});
      Dec(Y, FButton.Height {div 2});
      P := (Sender as TControl).ClientToScreen(Point(X, Y));
      FButton.Free;
      FButton := nil;
      if CheckSpeedBar and (FBar = FindSpeedBar(P)) then begin
        P := FBar.ScreenToClient(P);
        if FBar.AcceptDropItem(FDragItem, P.X, P.Y) then begin
          Designer.Modified;
        end;
      end;
    end
    else SetCursor(Screen.Cursors[ButtonsList.Cursor]);
  finally
    FDrag := False;
    FDragItem := nil;
  end;
end;

procedure TSpeedbarEditor.ButtonsListSelectCell(Sender: TObject; Col,
  Row: Longint; var CanSelect: Boolean);
var
  Item: TSpeedItem;
begin
  Item := ItemByRow(Row);
  CanSelect := not FDrag and (Item <> nil);
  if FLocked = 0 then begin
    if CanSelect then begin
      UpdateEnabled(Row, SectionList.Row);
      SelectButton(CurrentSection, Item, False);
    end
    else if not FDrag then begin
      UpdateEnabled(-1, SectionList.Row);
      SelectButton(-1, nil, True);
    end;
  end;
end;

procedure TSpeedbarEditor.FormCreate(Sender: TObject);
begin
  FImage := TButtonImage.Create;
  FButton := nil;
  FBar := nil;
  FDrag := False;
  if NewStyleControls then Font.Style := [];
  with FormPlacement1 do begin
    UseRegistry := True;
    IniFileName := SDelphiKey;
  end;
end;

procedure TSpeedbarEditor.FormDestroy(Sender: TObject);
begin
  FImage.Free;
end;

procedure TSpeedbarEditor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  FButton.Free;
  FButton := nil;
  if FBar <> nil then begin
    FBar.SetEditing(0);
    SelectButton(-1, nil, True);
    FBar.Invalidate;
  end;
  FBar := nil;
end;

procedure TSpeedbarEditor.SectionNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key = (VK_RETURN) then begin
    SectionNameExit(SectionName);
    Key := 0;
    ActiveControl := SectionList;
  end;
end;

procedure TSpeedbarEditor.ButtonsListDrawCell(Sender: TObject; Col,
  Row: Longint; Rect: TRect; State: TGridDrawState);
var
  I: Integer;
begin
  I := CurrentSection;
  if (I >= 0) and (Row < FBar.ItemsCount(I)) then
    DrawCellButton(Sender as TDrawGrid, Rect, ItemByRow(Row), FImage
      {$IFDEF RX_D4}, TDrawGrid(Sender).IsRightToLeft {$ENDIF});
end;

procedure TSpeedbarEditor.SectionListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Longint;
begin
  if (Button = mbLeft) then
    with (Sender as TDrawGrid) do begin
      MouseToCell(X, Y, ACol, ARow);
      Tag := Row;
      BeginDrag(False);
    end;
end;

procedure TSpeedbarEditor.SectionListDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  Col, Row: Longint;
begin
  try
    (Sender as TDrawGrid).MouseToCell(X, Y, Col, Row);
    FBar.Sections[(Sender as TDrawGrid).Tag].Index := Row;
    Designer.Modified;
    UpdateData;
    SectionList.Row := Row;
  finally
    (Sender as TDrawGrid).Tag := 0;
  end;
end;

procedure TSpeedbarEditor.SectionListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  Col, Row: Longint;
begin
  (Sender as TDrawGrid).MouseToCell(X, Y, Col, Row);
  Accept := (Row >= 0) and (Row <> (Sender as TDrawGrid).Tag);
end;

procedure TSpeedbarEditor.FormShow(Sender: TObject);
begin
  if FBar <> nil then UpdateListHeight;
  SectionList.DefaultColWidth := SectionList.ClientWidth;
  ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
end;

end.