Компонент Label забыли поправить.

Форумы КомпонентыКомпонент Label забыли поправить. ← Ctrl12Ctrl →

Этот топик читают: Гость

Ответов: 2059

Рейтинг: 131

#1: 2022-04-11 23:03:27 ЛС | профиль | цитата

Компонент Label забыли поправить на счёт Anchors.

unit hiLabel;

interface

uses Kol, Share,Win;

type
  THILabel = class(THIWin)
  private
    procedure SetAutoSize(Value: boolean);
    procedure SetAlignment(Value: TTextAlign);
    procedure SetVerticalAlign(Value: TVerticalAlign);
    procedure _OnClick(Sender: PObj);
  protected
    procedure _onMouseEnter(Sender: PObj); override;
    procedure _onMouseLeave(Sender: PObj); override;
  public
    _event_OnClick: THI_Event;
    _prop_ColorHover: integer;
    _prop_Underline: boolean;
    _prop_Caption: string;
    _prop_CaptionOnClick: boolean;
    _data_Text: THI_Event;

    procedure _work_DoText(var Data: TData; Index: word);
    procedure _work_doAlignment(var Data: TData; Index: word);
    procedure _work_doVerticalAlign(var Data: TData; Index: word);
    procedure _var_Caption(var Data: TData; Index: word);

    constructor Create(Parent: PControl);
    procedure Init; override;
    property _prop_AutoSize: boolean write SetAutoSize;
    property _prop_Alignment: TTextAlign write SetAlignment;
    property _prop_VerticalAlign: TVerticalAlign write SetVerticalAlign;
 end;

implementation

constructor THILabel.Create;
begin
  inherited Create(Parent);
  Control := NewLabel(Parent, 'Label');
  Control.OnClick := _OnClick;
end;

procedure THILabel.Init;
begin
  inherited;
  Control.Caption := _prop_Caption;
  if (_prop_ColorHover ‹› 0) or _prop_Underline then
  begin
    Control.onMouseEnter := _OnMouseEnter;
    Control.onMouseLeave := _OnMouseLeave;
  end;
end;

procedure THILabel._OnClick;
begin
  if _prop_CaptionOnClick then
    _hi_OnEvent(_event_OnClick, Control.Caption)
  else  
    _hi_OnEvent(_event_OnClick);
end;

procedure THILabel._OnMouseEnter;
begin
  inherited;
  if _prop_ColorHover ‹› 0 then
    Control.Font.Color := _prop_ColorHover;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle + [fsUnderline];
end;

procedure THILabel._OnMouseLeave;
begin
  inherited;
  if _prop_ColorHover ‹› 0 then
    Control.Font.Color := _prop_Font.Color;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle - [fsUnderline];
end;

procedure THILabel._work_DoText;
begin
  Control.Caption := ReadString(Data, _data_Text);
end;

procedure THILabel._work_doAlignment;
begin
  Control.TextAlign := TTextAlign(ToInteger(Data));
end;

procedure THILabel._work_doVerticalAlign;
begin
  Control.VerticalAlign := TVerticalAlign(ToInteger(Data));
end;

procedure THILabel.SetAlignment;
begin
  Control.TextAlign := Value;
end;

procedure THILabel.SetVerticalAlign;
begin
  Control.VerticalAlign := Value;
end;

procedure THILabel.SetAutoSize;
begin
  Control.AutoSize(Value);
end;

procedure THILabel._var_Caption;
begin
  dtString(Data, Control.Caption);
end;

end.

Редактировалось 2 раз(а), последний 2022-04-12 01:29:58

карма: 6

Google vip	#1.1контекстная реклама от партнеров

Разработчик

Ответов: 26066

Рейтинг: 2120

#2: 2022-04-11 23:37:20 ЛС | профиль | цитата

flint2 писал(а):

Компонент Label забыли поправить на счёт Anchors.

Не понял, а в чем проблема-то? И как-то на будущее -- можно более подробно конкретизировать вопросы?

Редактировалось 1 раз(а), последний 2022-04-11 23:38:36

карма: 22

Ответов: 2059

Рейтинг: 131

#3: 2022-04-12 00:20:58 ЛС | профиль | цитата

nesco, помнишь делали нововведения в компонентах связанные с закреплением размеров и их положения относительно верха-низа, лева-права. Тогда вносили изменения во все визуальные компоненты, а про Label забыли.
Не работали варианты, когда в Anchors akBottom и akRight = True - надпись исчезает.
Вверху поправленный скрипт.

Редактировалось 1 раз(а), последний 2022-04-12 00:41:22

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#4: 2022-04-12 00:57:11 ЛС | профиль | цитата

flint2, AutoSize отключи и никуда не должна исчезать. У меня все прекрасно работает без всяких изменений, даже при пустой надписи.

И про Label я ни как не мог забыть, тк Anchors встроен не в компоненты, а в родительский модуль Win. А то, что так себя ведет компонент при пустой строке со включенным AutoSize, то он изначально так работал.

Редактировалось 3 раз(а), последний 2022-04-12 01:01:48

карма: 22

Ответов: 2059

Рейтинг: 131

#5: 2022-04-12 01:15:35 ЛС | профиль | цитата

nesco писал(а):

тк Anchors встроен не в компоненты, а в родительский модуль Win.

Это я знаю.
Не очень удобно AutoSize отключать.
Достаточно вот здесь: Control := NewLabel(Parent, 'Label');
точку, или пробел поставить вместо пустой строки.

Редактировалось 3 раз(а), последний 2022-04-12 01:27:54

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#6: 2022-04-12 01:31:50 ЛС | профиль | цитата

flint2 писал(а):

но мне кажется легче сделать не пустую строку вот здесь: "Control := NewLabel(Parent, 'Label');"

Тут твое решение не совсем помогает -- попробуй с твоим решением и пустым Caption вписать извне слово, длиннее слова Label (при включенном AutoSize и Anchors akBottom и akRight = True), а потом изменить размер формы -- размер элемента Label улетит к размеру слова Label

--- Добавлено в 2022-04-12 01:47:42

А кто мешает сделать собственный AutoSize из рассыпухи, это же не сложно?

Редактировалось 2 раз(а), последний 2022-04-12 01:47:42

карма: 22

Ответов: 2059

Рейтинг: 131

#7: 2022-04-12 02:00:35 ЛС | профиль | цитата

Дело в том, что приспичело перекомпилировать старый проект на rutracker.org... Начал делать новые установки Anchors akBottom и akRight = True.
У меня давно были сделаны привязки к краям и в компонентах я ничего тогда не переделывал только в Win и Windows.pas. и всё работало. Проблема в Win.pas. У меня сохранились старые. Завтра посмотрю чем отличаются, я имею в виду не старые с SVN, а свои.
А то что я предложил это конечно костыль...
P.S.

попробуй с твоим решением и пустым Caption вписать извне слово, длиннее слова Label (при включенном AutoSize и Anchors akBottom и akRight = True), а потом изменить размер формы -- размер элемента Label улетит к размеру слова Label

Всё работает, но это не комильфо:

Add(MainForm,2953706,21,105)
{
}
Add(Label,3087497,294,126)
{
 Left=15
 Top=110
 Width=4
 Height=4
 akLeft=1
 akTop=1
 akRight=0
 akBottom=0
 Caption=""
}
Add(Counter,15780423,140,147)
{
 Max=3
 link(onNext,12830795:doGetString,[])
}
Add(Timer,8178503,77,147)
{
 link(onTimer,15780423:doNext,[])
}
Add(StrList,12830795,189,119)
{
 Strings=#11:Это я знаю.|35:Не очень удобно AutoSize отключать.|59:Достаточно вот здесь: Control := NewLabel(Parent, 'Label');|49:точку, или пробел поставить вместо пустой строки.|0:|
 Point(doGetString)
 Point(onGetString)
 link(onGetString,3087497:doText,[])
}

Control := NewLabel(Parent, ' '); // Здесь пробел.
Редактировалось 2 раз(а), последний 2022-04-12 02:21:07

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#8: 2022-04-12 02:38:22 ЛС | профиль | цитата

flint2 писал(а):

Control := NewLabel(Parent, ' '); // Здесь пробел.

Ну, поставил пробел, и все равно получил то, про что писал

--- Добавлено в 2022-04-12 02:50:52

Попробуй вот такой код (это с моим Win)

unit hiLabel;

interface

uses Kol, Share, Win;

type
  THILabel = class(THIWin)
  private
    fAutosize: boolean;
    procedure SetAutoSize(Value: boolean);
    procedure SetAlignment(Value: TTextAlign);
    procedure SetVerticalAlign(Value: TVerticalAlign);
    procedure _OnClick(Sender: PObj);
  protected
    procedure _onMouseEnter(Sender: PObj); override;
    procedure _onMouseLeave(Sender: PObj); override;
  public
    _event_OnClick: THI_Event;
    _prop_ColorHover: integer;
    _prop_Underline: boolean;
    _prop_Caption: string;
    _prop_CaptionOnClick: boolean;
    _data_Text: THI_Event;

    procedure _work_DoText(var Data: TData; Index: word);
    procedure _work_doAlignment(var Data: TData; Index: word);
    procedure _work_doVerticalAlign(var Data: TData; Index: word);
    procedure _var_Caption(var Data: TData; Index: word);

    constructor Create(Parent: PControl);
    procedure Init; override;
    property _prop_AutoSize: boolean read fAutosize write SetAutoSize;
    property _prop_Alignment: TTextAlign write SetAlignment;
    property _prop_VerticalAlign: TVerticalAlign write SetVerticalAlign;
 end;

implementation

constructor THILabel.Create;
begin
  fAutosize := false;
  inherited Create(Parent);
  Control := NewLabel(Parent, '');
  Control.OnClick := _OnClick;
end;

procedure THILabel.Init;
begin
  inherited;
  Control.Caption := _prop_Caption;
  if (_prop_ColorHover <> 0) or _prop_Underline then
  begin
    Control.onMouseEnter := _OnMouseEnter;
    Control.onMouseLeave := _OnMouseLeave;
  end;
end;

procedure THILabel._OnClick;
begin
  if _prop_CaptionOnClick then
    _hi_OnEvent(_event_OnClick, Control.Caption)
  else  
    _hi_OnEvent(_event_OnClick);
end;

procedure THILabel._OnMouseEnter;
begin
  inherited;
  if _prop_ColorHover <> 0 then
    Control.Font.Color := _prop_ColorHover;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle + [fsUnderline];
end;

procedure THILabel._OnMouseLeave;
begin
  inherited;
  if _prop_ColorHover <> 0 then
    Control.Font.Color := _prop_Font.Color;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle - [fsUnderline];
end;

procedure THILabel._work_DoText;
begin
  Control.Caption := ReadString(Data, _data_Text);
  if fAutosize then
  begin
    fDefTop    := Control.Top;
    fDefLeft   := Control.Left;
    fDefRight  := Control.Parent.Width - (Control.Left + Control.Width);
    fDefBottom := Control.Parent.Height - (Control.Top + Control.Height);
    fDefWidth  := Control.Width;
    fDefHeight := Control.Height;
  end;
end;

procedure THILabel._work_doAlignment;
begin
  Control.TextAlign := TTextAlign(ToInteger(Data));
end;

procedure THILabel._work_doVerticalAlign;
begin
  Control.VerticalAlign := TVerticalAlign(ToInteger(Data));
end;

procedure THILabel.SetAlignment;
begin
  Control.TextAlign := Value;
end;

procedure THILabel.SetVerticalAlign;
begin
  Control.VerticalAlign := Value;
end;

procedure THILabel.SetAutoSize;
begin
  Control.AutoSize(Value);
  fAutosize := Value;
end;

procedure THILabel._var_Caption;
begin
  dtString(Data, Control.Caption);
end;

end.

Редактировалось 2 раз(а), последний 2022-04-12 02:51:23

карма: 22

Ответов: 2059

Рейтинг: 131

#9: 2022-04-12 02:56:08 ЛС | профиль | цитата

Да я понимаю.
У меня не так было сделано в Win.pas:

 ..... fAnchor:integer;....
property AnchorsFlag:integer read fAnchor write fAnchor;
......
flags := THIWin(C).AnchorsFlag;
......
      if _prop_akLeft then   fAnchor := fAnchor or 1;
      if _prop_akTop  then   fAnchor := fAnchor or 2;
      if _prop_akRight then  fAnchor := fAnchor or 4;
      if _prop_akBottom then fAnchor := fAnchor or 8;

      Control.MarginLeft   := _prop_MarginLeft;
      Control.MarginTop    := _prop_MarginTop;
      Control.MarginRight  := _prop_MarginRight;
      Control.MarginBottom := _prop_MarginBottom;
      Control.Margin       := _prop_Margin;

      Control.MaxHeight :=  _prop_MaxHeight;
      Control.MaxWidth  :=  _prop_MaxWidth;
      Control.MinHeight :=  _prop_MinHeight;
      Control.MinWidth  :=  _prop_MinWidth;

      THIWin(Control).fMaxHeight :=  _prop_MaxHeight;
      THIWin(Control).fMaxWidth  :=  _prop_MaxWidth;
      THIWin(Control).fMinHeight :=  _prop_MinHeight;
      THIWin(Control).fMinWidth  :=  _prop_MinWidth;
.....
      THIWin(Control).AnchorsFlag := fAnchor;

--- Добавлено в 2022-04-12 03:08:41

nesco писал(а):

Попробуй вот такой код (это с моим Win)

Нет, не работает. Изначально нет надписей.

--- Добавлено в 2022-04-12 03:14:53

nesco писал(а):

Попробуй вот такой код (это с моим Win)

Нет, не работает. Изначально нет надписей.

Редактировалось 5 раз(а), последний 2022-04-12 03:14:53

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#10: 2022-04-12 03:40:20 ЛС | профиль | цитата

Так предложенный код работает или как?

карма: 22

Ответов: 2059

Рейтинг: 131

#11: 2022-04-12 03:45:46 ЛС | профиль | цитата

Нет, не работает. Изначально нет надписей.
Только когда идёт замена надписи, тогда только появляется, а при старте программы надписи нет.
В принципе, можно делать изначально больший размер и ставить AutoSize=False.

Редактировалось 1 раз(а), последний 2022-04-12 03:53:43

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#12: 2022-04-12 03:59:47 ЛС | профиль | цитата

flint2 писал(а):

Изначально нет надписей

Аааа, я наконец-то понял, что тебе надо.

--- Добавлено в 2022-04-12 04:03:38

Но если нет Caption-a, то откуда возьмется размер, если включен Autosize? Или ты хочешь иметь исходный размер при старте со включенным Autosize? Тут надо подумать.
-- delete --
Пока у меня не получается при пустой строке и включенным Autosize оставить исходный размер.

Редактировалось 5 раз(а), последний 2022-04-12 04:15:55

карма: 22

Ответов: 2059

Рейтинг: 131

#13: 2022-04-12 04:20:30 ЛС | профиль | цитата

У меня пять надписей.
Изначально у Caption есть своё значение.
В последствии надписи асинхронно меняются.
+ они меняют своё положение с изменением формы.
Одни привязаны Bottom другие к Right, некоторые и к Bottom, и Right.
Сама по себе проблема решается заведомо большим статичным размером без Autosize.
Просто как то неожиданно получилось.
Никогда такого не было и вот опять.

Редактировалось 1 раз(а), последний 2022-04-12 04:23:34

карма: 6

Разработчик

Ответов: 26066

Рейтинг: 2120

#14: 2022-04-12 04:29:22 ЛС | профиль | цитата

Кажется я добился при пустой строке исходного размера. Можно, конечно, сделать сохранение размера для любого текста при включенном Autosize, но я считаю это не правильно. Если включен Autosize, то размер должен меняться и при запуске.

unit hiLabel;

interface

uses Kol, Share, Win;

type
  THILabel = class(THIWin)
  private
    fAutosize: boolean;
    procedure SetAutoSize(Value: boolean);
    procedure SetAlignment(Value: TTextAlign);
    procedure SetVerticalAlign(Value: TVerticalAlign);
    procedure _OnClick(Sender: PObj);
  protected
    procedure _onMouseEnter(Sender: PObj); override;
    procedure _onMouseLeave(Sender: PObj); override;
  public
    _event_OnClick: THI_Event;
    _prop_ColorHover: integer;
    _prop_Underline: boolean;
    _prop_Caption: string;
    _prop_CaptionOnClick: boolean;
    _data_Text: THI_Event;

    procedure _work_DoText(var Data: TData; Index: word);
    procedure _work_doAlignment(var Data: TData; Index: word);
    procedure _work_doVerticalAlign(var Data: TData; Index: word);
    procedure _var_Caption(var Data: TData; Index: word);

    constructor Create(Parent: PControl);
    procedure Init; override;
    property _prop_AutoSize: boolean read fAutosize write SetAutoSize;
    property _prop_Alignment: TTextAlign write SetAlignment;
    property _prop_VerticalAlign: TVerticalAlign write SetVerticalAlign;
 end;

implementation

constructor THILabel.Create;
begin
  fAutosize := false;
  inherited Create(Parent);
  Control := NewLabel(Parent, '');
  Control.OnClick := _OnClick;
end;

procedure THILabel.Init;
begin
  inherited;
  Control.Caption := _prop_Caption;
  if fAutosize then
  begin
    if _prop_Caption = '' then
    begin
      Control.Width := _prop_Width;
      Control.Height := _prop_Height;
    end;
    fDefTop    := Control.Top;
    fDefLeft   := Control.Left;
    fDefRight  := Control.Parent.Width - (Control.Left + Control.Width);
    fDefBottom := Control.Parent.Height - (Control.Top + Control.Height);
    fDefWidth  := Control.Width;
    fDefHeight := Control.Height;
  end;
  if (_prop_ColorHover <> 0) or _prop_Underline then
  begin
    Control.onMouseEnter := _OnMouseEnter;
    Control.onMouseLeave := _OnMouseLeave;
  end;
  Control.Invalidate;
end;

procedure THILabel._OnClick;
begin
  if _prop_CaptionOnClick then
    _hi_OnEvent(_event_OnClick, Control.Caption)
  else  
    _hi_OnEvent(_event_OnClick);
end;

procedure THILabel._OnMouseEnter;
begin
  inherited;
  if _prop_ColorHover <> 0 then
    Control.Font.Color := _prop_ColorHover;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle + [fsUnderline];
end;

procedure THILabel._OnMouseLeave;
begin
  inherited;
  if _prop_ColorHover <> 0 then
    Control.Font.Color := _prop_Font.Color;
  if _prop_Underline then
    Control.Font.FontStyle := Control.Font.FontStyle - [fsUnderline];
end;

procedure THILabel._work_DoText;
begin
  Control.Caption := ReadString(Data, _data_Text);
  if fAutosize then
  begin
    fDefTop    := Control.Top;
    fDefLeft   := Control.Left;
    fDefRight  := Control.Parent.Width - (Control.Left + Control.Width);
    fDefBottom := Control.Parent.Height - (Control.Top + Control.Height);
    fDefWidth  := Control.Width;
    fDefHeight := Control.Height;  
  end;
end;

procedure THILabel._work_doAlignment;
begin
  Control.TextAlign := TTextAlign(ToInteger(Data));
end;

procedure THILabel._work_doVerticalAlign;
begin
  Control.VerticalAlign := TVerticalAlign(ToInteger(Data));
end;

procedure THILabel.SetAlignment;
begin
  Control.TextAlign := Value;
end;

procedure THILabel.SetVerticalAlign;
begin
  Control.VerticalAlign := Value;
end;

procedure THILabel.SetAutoSize;
begin
  Control.AutoSize(Value);
  fAutosize := Value;
end;

procedure THILabel._var_Caption;
begin
  dtString(Data, Control.Caption);
end;

end.

Убери условие if _prop_Caption = '' then и исходный размер сохранится при любом тексте при старте.

--- Добавлено в 2022-04-12 04:46:39

Добавил новое свойство AutosizeAtStart и выложил отдельным архивом.

Редактировалось 3 раз(а), последний 2022-04-12 04:46:39

карма: 22

файлы: 1 hiLabel_AutosizeAtStart.zip [1.8KB] [284]

Ответов: 2059

Рейтинг: 131

#15: 2022-04-12 09:20:52 ЛС | профиль | цитата

nesco писал(а):

Добавил новое свойство AutosizeAtStart и выложил отдельным архивом.

Да, нормально!

скрытый текст

Ты что, никогда не спишь?

карма: 6

Форумы КомпонентыКомпонент Label забыли поправить. ← Ctrl12Ctrl →


Сообщение ...
Прикрепленные файлы (файлы не залиты)