jvspeedbarform.pas

East make Tray Icon in delphi

  I, Sect: Integer;
begin
  if CheckSpeedBar and FBar.FindItem(ItemByRow(ButtonsList.Row), Sect, I) then
    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;

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

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

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

procedure TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.SectionListDrawCell(Sender: TObject; Col,
  Row: Longint; Rect: TRect; State: TGridDrawState);
begin
  if CheckSpeedBar then
    if (Row < FBar.SectionCount) and (Row >= 0) then
      DrawCellText(Sender as TDrawGrid, Col, Row,
        FBar.Sections[Row].Caption, Rect, taLeftJustify, vaCenterJustify, TDrawGrid(Sender).IsRightToLeft);
end;

procedure TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.ButtonsListDblClick(Sender: TObject);
const
  {$IFDEF BCB}
  cSender: string[7] = '*Sender';
  {$ELSE}
  cSender: string[6] = 'Sender';
  {$ENDIF BCB}
  cObject: string[7] = 'TObject';
  cClick = 'Click';
  cOnClick = 'OnClick';
type
  PParamData = ^TParamData;
  TParamData = record
    Flags: TParamFlags;
    ParamNameAndType: array [0..100] of Char;
  end;
var
  Btn: TJvSpeedItem;
  I, Num: Integer;
  MethodName: string;
  Method: TMethod;
  TypeData: PTypeData;
  ParamData: PParamData;
  PropInfo: PPropInfo;
  Candidates: TJvPropInfoList;
begin
  Btn := ItemByRow(ButtonsList.Row);
  if Btn = nil then
    Exit;
  Candidates := TJvPropInfoList.Create(Btn, [tkMethod]);
  try
    for I := Candidates.Count - 1 downto 0 do
    begin
      PropInfo := Candidates[I];
      if CompareText(PropInfo^.Name, cOnClick) = 0 then
      begin
        Method := GetMethodProp(Btn, PropInfo);
        MethodName := IJvFormDesigner(Designer).GetMethodName(Method);
        if MethodName = '' then
        begin
          MethodName := Btn.Name + cClick;
          Num := 0;
          while IJvFormDesigner(Designer).MethodExists(MethodName) do
          begin
            MethodName := Btn.Name + cClick + 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 := [];
              // (rom) WARNING! Needs check against buffer overflow.
              ParamNameAndType[0] := Char(Length(cSender));
              Move(cSender[1], ParamNameAndType[1], Length(cSender));
              ParamNameAndType[Length(cSender) + 1] := Char(Length(cObject));
              Move(cObject[1], ParamNameAndType[Length(cSender) + 2],
                Length(cObject));
            end;
            Method := IJvFormDesigner(Designer).CreateMethod(MethodName, TypeData);
            Method.Data := OwnerForm;
          finally
            FreeMem(TypeData, SizeOf(TTypeData));
          end;
          Btn.OnClick := TNotifyEvent(Method);
          Designer.Modified;
        end;
        if (MethodName <> '') and IJvFormDesigner(Designer).MethodExists(MethodName) then
          IJvFormDesigner(Designer).ShowMethod(MethodName);
        Break;
      end;
    end;
  finally
    Candidates.Free;
  end;
end;

procedure TJvSpeedbarEditorMain.ButtonsListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Item: TJvSpeedItem;
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 := TJvBtnControl.Create(Self);
          TJvBtnControl(FButton).AssignSpeedItem(Item);
        end;
      end;
    end;
  end;
end;

procedure TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.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
          Designer.Modified;
      end;
    end
    else
      SetCursor(Screen.Cursors[ButtonsList.Cursor]);
  finally
    FDrag := False;
    FDragItem := nil;
  end;
end;

procedure TJvSpeedbarEditorMain.ButtonsListSelectCell(Sender: TObject;
  Col, Row: Longint; var CanSelect: Boolean);
var
  Item: TJvSpeedItem;
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 TJvSpeedbarEditorMain.FormCreate(Sender: TObject);
begin
  FImage := TJvButtonImage.Create;
  FButton := nil;
  FBar := nil;
  FDrag := False;
  if NewStyleControls then
    Font.Style := [];
  AppStorage.Root := SDelphiKey;
end;

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

procedure TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.SectionNameKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    SectionNameExit(SectionName);
    Key := 0;
    ActiveControl := SectionList;
  end;
end;

procedure TJvSpeedbarEditorMain.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, TDrawGrid(Sender).IsRightToLeft);
end;

procedure TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.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 TJvSpeedbarEditorMain.FormShow(Sender: TObject);
begin
  if FBar <> nil then
    UpdateListHeight;
  SectionList.DefaultColWidth := SectionList.ClientWidth;
  ButtonsList.DefaultColWidth := ButtonsList.ClientWidth;
end;

end.