Программирование на Delphi

FAQ VCL
Компоненты\Общие вопросы

:: Меню ::

:: На главную ::

:: FAQ ::

:: Заметки ::

:: Практика ::

:: Win API ::

:: Проекты ::

:: Скачать ::

:: Секреты ::

:: Ссылки ::

:: Сервис ::

:: Написать ::

:: MVP ::

:: RSS ::

Как перемещать компоненты по форме в режиме работы программы?


// Способ первый
// В примере показывается, как перемещать панель.
// Однако этот метод можно применять к любым компонентам.

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Panel1.Perform(WM_SYSCOMMAND, $F012, 0);
end;

// Частный случай
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{$IFNDEF WIN32}
var
  pt: TPoint;
{$ENDIF}
begin
  if ssCtrl in Shift then
  begin
    ReleaseCapture;
    SendMessage(Button1.Handle, WM_SYSCOMMAND, $F012, 0);
    {$IFNDEF WIN32}
    GetCursorPos(pt);
    SendMessage(Button1.Handle, WM_LBUTTONUP, MK_CONTROL, Longint(pt));
    {$ENDIF}
  end;
end;

// Способ второй
var
  Move: Boolean;
  X0, Y0: Integer;

implementation

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbLeft then
    Exit;

  X0 := X;
  Y0 := Y;
  Move := true;
  (Sender as TControl).BringToFront;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if move then
    with Sender as TControl do
      SetBounds(Left + X - X0, Top + Y - Y0, Width, Height);
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Move := False;
end;

// Способ третий
var
  Move: Boolean;
  X0, Y0: Integer;
  Rec: TRect;

implementation

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbLeft then
    Exit;

  X0 := X;
  Y0 := Y;
  Rec := (Sender as TControl).BoundsRect;
  Move := True;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if not Move then
    Exit;

  Canvas.DrawFocusRect(Rec);
  with Rec do
  begin
    Left := Left + X - X0;
    Right := Right + X - X0;
    Top := Top + Y - Y0;
    Bottom := Bottom + Y - Y0;
  end;
  X0 := X;
  Y0 := Y;
  Canvas.DrawFocusRect(Rec);
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Canvas.DrawFocusRect(Rec);
  with Sender as TControl do
  begin
    SetBounds(Rec.Left + X - X0, Rec.Top + Y - Y0, Width, Height);
    BringToFront;
  end;
  Move := False;
end;

Как сделать, чтобы компоненты отбрасывали тень?


procedure ShadeIt( f: TForm; c: TControl; Width: Integer; Color: TColor );
var  
  rect: TRect;  
  old: TColor;  
begin  
  if c.Visible then
  begin
    rect := c.BoundsRect;
    rect.Left := rect.Left + Width;
    rect.Top := rect.Top + Width;
    rect.Right := rect.Right + Width;
    rect.Bottom := rect.Bottom + Width;
    old := f.Canvas.Brush.Color;
    f.Canvas.Brush.Color := Color;
    f.Canvas.FillRect(rect);
    f.Canvas.Brush.Color := old;
  end;
end;  

procedure TForm1.FormPaint(Sender: TObject);
var  
  i: Integer;
begin
  for i := 0 to Self.ControlCount-1 do
    ShadeIt(Self, Self.Controls[i], 3, clBlack);
end;

Как перебрать все компоненты на форме?


procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  s: string;
begin
  for i := 0 to ComponentCount-1 do
    s := s + Components[i].Name + #13;
  ShowMessage(s);
end;

Как среди всех компонентов на форме найти нужные?


// Способ первый
// Найти все CheckBox
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to ComponentCount-1 do
    if (Components[i] is TCheckBox) then
      (Components[i] as TCheckBox).Checked := True;
end;

// Способ второй
// Найти все контролы с определенным значением тега
function FindAllControlsByTag(ATag: Integer): string;

  procedure FindAllControls(AControl: TWinControl; var AList: TStrings);
  var
    i: Integer;
  begin
    Assert(Assigned(AList), 'Передан недействительный список');

    for i := 0 to AControl.ControlCount-1 do
      if AControl.Controls[i] is TWinControl then
      begin
        if TWinControl(AControl.Controls[i]).ControlCount > 0 then
          FindAllControls(TWinControl(AControl.Controls[i]), AList);
        if AControl.Controls[i].Tag = ATag then
          AList.Add(AControl.Controls[i].Name);
      end;
  end;

var
  sl: TStrings;
begin
  sl := TStringList.Create;
  try
    FindAllControls(Form1, sl);
    Result := sl.CommaText;
  finally
    sl.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FindAllComponentsByTag(23));
end;

// Способ третий
// Найти все компоненты с определенным значением тега
function FindAllComponentsByTag(ATag: Integer): string;

  procedure FindAllComponents(AComponent: TComponent; var AList: TStrings);
  var
    i: Integer;
  begin
    Assert(Assigned(AList), 'Передан недействительный список');

    for i := 0 to AComponent.ComponentCount-1 do
    begin
      if TWinControl(AComponent.Components[i]).ComponentCount > 0 then
        FindAllComponents(TComponent(AComponent.Components[i]), AList);
      if AComponent.Components[i].Tag = ATag then
        AList.Add(AComponent.Components[i].Name);
    end;
  end;

var
  sl: TStrings;
begin
  sl := TStringList.Create;
  try
    FindAllComponents(Form1, sl);
    Result := sl.CommaText;
  finally
    sl.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FindAllComponentsByTag(23));
end;

Как найти компонент по имени?


// Допустим, у нас на форме 10 компонентов CheckBox

// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to 10 do
    (FindComponent(Format('CheckBox%d', [i])) as TCheckBox).Checked := True;
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to 10 do
    TCheckBox(FindComponent(Format('CheckBox%d', [i]))).Checked := True;
end;

Как создать компонент в Run-Time?


procedure TForm1.Button1Click(Sender: TObject);
var
  CheckBox: TCheckBox;
begin
  CheckBox := TCheckBox.Create(Self);
  CheckBox.Parent := Self;
  CheckBox.Left := 10;
  CheckBox.Top := 10;
  CheckBox.Caption := 'MyName';
  CheckBox.Visible := True;
end;

Как переместить фокус ввода на следующий компонент?


// Способ первый
procedure TForm1.FormClick(Sender: TObject);
begin
  SendMessage(Form1.Handle, WM_NEXTDLGCTL, 0, 0);
end;

// Способ второй
procedure TForm1.FormClick(Sender: TObject);
begin
  Perform(WM_NEXTDLGCTL, 0, 0);
end;

// Способ третий
// свойство формы KeyPreview = True
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #32 {пробел} then
  begin
    Key := #0;
    FindNextControl(ActiveControl, True, True, False).SetFocus;
  end;
end;

Как получить индекс компонента в списке родителя?


// Функция возвращает индекс искомого компонента в списке
// родителя или -1 при отсутствии компонента
function IndexInParent(vControl: TControl): integer;
var
  ParentControl: TWinControl;
begin
  // Делаем "слепок" родителя через базовой класс
  // на предмет доступности
  ParentControl := TForm(vControl.Parent);
  if ParentControl <> nil then
  begin
    for Result := 0 to ParentControl.ControlCount - 1 do
    begin
      if ParentControl.Controls[Result] = vControl then
        Exit;
    end;
  end;
  // если мы уж попали в это место, то либо не найден
  // компонент, либо компонент не имел родителя
  Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(IntToStr(IndexInParent(Sender as TControl)));
end;

Как свернуть компонент на форме?


// Сворачиваем панель
procedure TForm1.Panel1Click(Sender: TObject);
begin
  CloseWindow(Panel1.Handle);
end;

// Сворачиваем кнопку
procedure TForm1.Button1Click(Sender: TObject);
begin
  CloseWindow(Button1.Handle);
end;

Как получить представление компонента в виде строки?


function ComponentToString(Component: TComponent): string;
var
  BinStream: TMemoryStream;
  StrStream: TStringStream;
begin
  Result := '';
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(Result);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result := StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ComponentToString(Button1));
end;

При использовании материала - ссылка на сайт обязательна