Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.02.2011, 01:07   #1
xrob
Форумчанин
 
Регистрация: 18.10.2010
Сообщений: 419
По умолчанию наложение маски на визуальные объекты

здрасти =)
как сделать так чтобы любой (конкретный) визуальный компонент
был виден только в определенной области формы.
т.е. маска.

желательно указать функцией, например

mask(buton1,0,0,200,30); // сделать так чтоб батон1 был виден только на полоске шириной 200 и высотой 30 вверху формы

без openGL и DirectX пожалуйста.


p.s.
извиняюсь за краткость.
я писал длинное и подробное сообщение по этому вопросу,
но ваш форум благополучно сбросил мой аккаунт, пока я это делал,
и когда я закончил писать и хотел было запостить сообщение,
то мне предложили зарегистрироваться на форуме [*&^@&$!!!]
завтро пойду покупать новую клаву.
передаю горячий привет тем кто придумал такую фишку.

Последний раз редактировалось xrob; 22.02.2011 в 01:10.
xrob вне форума Ответить с цитированием
Старый 22.02.2011, 04:04   #2
ArtGrek
DelphiProger
Участник клуба
 
Аватар для ArtGrek
 
Регистрация: 14.11.2010
Сообщений: 1,023
По умолчанию

Цитата:
был виден только в определенной области формы.
вы его двигать собрались, и хотите что б при движении за пределы етих координат он становился невидимым?
если да, то зачем???
если нет то что вы хотите???
расскажите подробнее о вашеи програме
VirusN13
ArtGrek вне форума Ответить с цитированием
Старый 22.02.2011, 06:00   #3
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,281
По умолчанию


Код:
type
  TMaskPanel = class (TPanel) // Тип панели эмитирующей маску
  end;

procedure ControlMask (AControl: TControl; ARect: PRect);
// Если ARect=nil, то сущ-ая маска просто удалится
var
  p: TMaskPanel;
begin
  if AControl.Parent is TMaskPanel then begin // Если на контрол уже наложена маска, то ее нужно снять перед наложением новой
    p := (AControl.Parent as TMaskPanel);
    AControl.Left := AControl.Left + p.Left; // позиционируем контрол по X
    AControl.Top  := AControl.Top  + p.Top ; // позиционируем контрол по Y
    AControl.Parent := p.Parent; // переносим его на нового родителя
    p.Free; // уничтожаем панель-маску
  end;

  if ARect <> nil then begin // Если нужно наложить маску
    p := TMaskPanel.Create (Application); // cоздаем новую панель-маску
    P.BevelOuter := bvNone; // делаем её незаметной
    P.Caption := ''; // текст нам в принципе тоже не нужен
    p.BoundsRect := ARect^; // позиционируем панель-маску
    p.Parent := AControl.Parent; // переносим ее на родителя

    with AControl do begin
      Parent := p; // переносим контрол на панель-маску
      Left := Left - ARect.Left; // позиционируем (смещаем) по X
      Top  := Top  - ARect.Top ; // позиционируем (смещаем) по Y

      if Left > 0 then begin // Обрезаем маску слева
        p.Left  := p.Left  + Left;
        p.Width := p.Width - Left;
        Left := 0;
      end;

      if Top > 0 then begin // Обрезаем маску сверху
        p.Top    := p.Top    + Top;
        p.Height := p.Height - Top;
        Top := 0;
      end;

      if (Left + Width) < p.Width then begin // Обрезаем маску справа
        p.Width := Left + Width;
      end;

      if (Top + Height) < p.Height then begin // Обрезаем маску снизу
        p.Height := Top + Height;
      end;
    end;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
begin
  if Button1.Parent is TMaskPanel then // Если на контрол уже наложена маска
    ControlMask (Button1, nil) // то снимает её
  else begin // иначе
    r := Rect (0, 0, 200, 30);
    ControlMask (Button1, @r) // накладываем маску
  end;
  Button1.SetFocus;
end;

Последний раз редактировалось Sibedir; 22.02.2011 в 10:09. Причина: Добавил комментарии
Sibedir вне форума Ответить с цитированием
Старый 22.02.2011, 06:43   #4
ArtGrek
DelphiProger
Участник клуба
 
Аватар для ArtGrek
 
Регистрация: 14.11.2010
Сообщений: 1,023
По умолчанию

Sibedir могли бы вы пояснить, проверка чего ето?
Цитата:
Button1.Parent is TMaskPanel
если родитель кнопки имеет тип TPanel? я верно понял?
и если не сложно, вставте пажалуста коментарии в первые 2 абзаца процедуры ControlMask
хочу понять что там происходит, и как ето можно использовать
VirusN13
ArtGrek вне форума Ответить с цитированием
Старый 22.02.2011, 11:23   #5
Sibedir
Тот ещё
Старожил
 
Аватар для Sibedir
 
Регистрация: 14.11.2007
Сообщений: 2,281
По умолчанию

Вот, если интересно, немного доработал
Код:
type
  TMaskControl = class (TWinControl) // Тип контрола эмитирующего маску
  end;

procedure SetZ (AControl: TControl; AZ: Integer);
// Позиционирует контрол по Z
var
  Pos: HWND;
begin
  AControl.ComponentIndex := AZ;

  if (AControl is TWinControl) then
  with TWinControl(AControl) do begin
    if AZ = 0 then
      Pos := HWND_BOTTOM
    else
      if AZ >= Parent.ComponentCount - 1 then
        Pos := HWND_TOP
      else
        Pos := TWinControl(Parent.Components[AZ-1]).Handle;

    SetWindowPos(Handle, Pos, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE);
  end;
end;

procedure ControlMask (AControl: TControl; ARect: PRect);
// Если ARect=nil, то сущ-ая маска просто удалится
var
  p: TMaskControl;
  b: Boolean;
begin
  if AControl.Parent is TMaskControl then begin // Если на контрол уже наложена маска, то ее нужно снять перед наложением новой
    p := (AControl.Parent as TMaskControl);
    AControl.Left := AControl.Left + p.Left; // позиционируем (смещаем) контрол по X
    AControl.Top  := AControl.Top  + p.Top ; // позиционируем (смещаем) контрол по Y
    if AControl is TWinControl then // если контрол - это TWinControl
      b := TWinControl (AControl).Focused // запоминаем состояние фокуса контрола
    else
      b := False;
    AControl.Parent := p.Parent; // переносим его на нового родителя
    if b then TWinControl (AControl).SetFocus; // устанавливаем фокус контрола
    SetZ (AControl, p.ComponentIndex); // позиционируем контрол по Z
    if AControl is TWinControl then // если контрол - это TWinControl
      TWinControl (AControl).TabOrder := p.TabOrder; // назначаем ему TabOrder
    p.Free; // уничтожаем панель-маску
  end;

  if ARect <> nil then begin // Если нужно наложить маску
    p := TMaskControl.Create (Application); // cоздаем новую маску
    p.BoundsRect := ARect^; // позиционируем её
    if AControl is TWinControl then // если контрол - это TWinControl
      b := TWinControl (AControl).Focused // запоминаем состояние фокуса контрола
    else
      b := False;
    p.Parent := AControl.Parent; // переносим на родителя
    if AControl is TWinControl then // если контрол - это TWinControl
      p.TabOrder := TWinControl (AControl).TabOrder; // назначаем маске TabOrder
    p.TabStop := False; // не останавливаемся на маске по Tab
    SetZ (p, AControl.ComponentIndex); // позиционируем маску по Z

    with AControl do begin
      Parent := p; // переносим контрол на маску
      if b then TWinControl (AControl).SetFocus; // устанавливаем фокус контрола
      Left := Left - ARect.Left; // позиционируем (смещаем) его по X
      Top  := Top  - ARect.Top ; // позиционируем (смещаем) его по Y

      if Left > 0 then begin // Обрезаем маску слева
        p.Left  := p.Left  + Left;
        p.Width := p.Width - Left;
        Left := 0;
      end;

      if Top > 0 then begin // Обрезаем маску сверху
        p.Top    := p.Top    + Top;
        p.Height := p.Height - Top;
        Top := 0;
      end;

      if (Left + Width) < p.Width then begin // Обрезаем маску справа
        p.Width := Left + Width;
      end;

      if (Top + Height) < p.Height then begin // Обрезаем маску снизу
        p.Height := Top + Height;
      end;
    end;
  end;
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  c: TControl;
begin
  if Sender is TControl then begin
    c := (Sender as TControl);
    if c.Parent is TMaskControl then // Если на контрол уже наложена маска
      ControlMask (c, nil) // то снимает её
    else begin // иначе
      r := Rect (50, 20, 200, 30);
      ControlMask (c, @r) // накладываем маску
    end;
  end;
end;
Возможны баги
Sibedir вне форума Ответить с цитированием
Старый 23.02.2011, 20:05   #6
xrob
Форумчанин
 
Регистрация: 18.10.2010
Сообщений: 419
По умолчанию

да, ссори за молчание...

пишу (как это ни банально) браузер =)
да, разумеется, гугель и прочую хрень мне не переплюнуть,
но я так, для себя...

задумка такая, что интерфейс будет на flash,
а сам браузер - компонент TWebBrowser.

ссори за тормознутость, но я просто хотел убрать прокрутку у компонента...
а с учетом того что я только что написал компонент прокрутки в flash,
то я находился под влиянием этого и не смог придумать ничего лучше, чем
увеличить размер компонента так, чтобы содержимое влезало полностью,
разумеется он станет больше формы, но я хотел как раз таки наложить на него маску, и прокручивать с помощью компонента на flash =)

вот так вот мудрено...
xrob вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
MaskEdit - маски Alana Компоненты Delphi 4 20.10.2010 10:34
маски лапласиана PROVIDENCE Помощь студентам 0 16.03.2010 22:48
С++ Маски selumin Помощь студентам 2 12.10.2009 21:40