|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#16
|
|||
|
|||
Ну это наверно не очень удобно, каждый раз вырисовывать текст на канве, да и сколько там всего прописывать надо, поэтому я и использую Label, кидаешь их куда угодно, 2 строчки кода и всё.
|
#17
|
||||
|
||||
Ты спросил, я ответил. Хотя, если завернуть в процедуру, вызов составит 1 строку.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#18
|
|||
|
|||
А в мой модуль нельзя как-нибудь эти Ваши функции завернуть, чтобы потом все Label-ы, более чётче перерисовывались?
А то в данном модуле черная обводка например, на некоторых картинках отсвечивает иногда красным, да и другми цветами, нет четкого контура. Может можно и проще в модуле дописать, вам как специалистам виднее. Плюсики, спасибы и благодарности всегда за мной. |
#19
|
||||
|
||||
Я тут на скорую руку состряпял юнит:
stroke.pas Код:
unit stroke; interface uses Windows, Messages, Classes, Controls, Graphics, StdCtrls; type TCustomStrokeLabel = class(TCustomLabel) private fShowAccelChar : Boolean; fAlignment : TAlignment; fLayout : TTextLayout; fWordWrap : Boolean; fPathColor : TColor; procedure SetAlignment(Value : TAlignment); procedure SetShowAccelChar(Value : Boolean); function GetPathColor : TColor; procedure SetPathColor(aColor : TColor); protected function GetLabelText : String ; override; procedure DoDrawText(var Rect : TRect; Flags : Longint); override; procedure Paint; override; property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; property ShowAccelChar : Boolean read FShowAccelChar write SetShowAccelChar default True; public constructor Create(AOwner : TComponent); override; property PathColor : TColor read GetPathColor write SetPathColor default clRed; end; TStrokeLabel = class(TCustomStrokeLabel) published property Align; property Alignment; property Anchors; property AutoSize; property BiDiMode; property Caption; property Color nodefault; property Constraints; property DragCursor; property DragKind; property DragMode; property Enabled; property FocusControl; property Font; property ParentBiDiMode; property ParentColor; property ParentFont; property ParentShowHint; property PathColor; property PopupMenu; property ShowAccelChar; property ShowHint; property Transparent; property Layout; property WordWrap; property OnClick; property OnContextPopup; property OnDblClick; property OnDragDrop; property OnDragOver; property OnEndDock; property OnEndDrag; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseEnter; property OnMouseLeave; property OnStartDock; property OnStartDrag; end; procedure Register; implementation { TStrokeLabel } constructor TCustomStrokeLabel.Create(AOwner : TComponent); begin inherited Create(AOwner); fShowAccelChar := True; fPathColor := clRed; end; function TCustomStrokeLabel.GetLabelText : String; begin Result := Caption; end; procedure TCustomStrokeLabel.DoDrawText(var Rect : TRect; Flags : Longint); var Text : String; begin Text := GetLabelText; if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' '; if not FShowAccelChar then Flags := Flags or DT_NOPREFIX; Flags := DrawTextBiDiModeFlags(Flags); Canvas.Font := Font; if not Enabled then begin OffsetRect(Rect, 1, 1); Canvas.Font.Color := clBtnHighlight; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); OffsetRect(Rect, -1, -1); Canvas.Font.Color := clBtnShadow; DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); end else begin Canvas.Brush.Style := bsClear; Canvas.Pen.Color := fPathColor; BeginPath(Canvas.Handle); DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags); EndPath(Canvas.Handle); Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Canvas.Font.Color; StrokeAndFillPath(Canvas.Handle); end; end; procedure TCustomStrokeLabel.Paint; const Alignments : array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER); WordWraps : array[Boolean] of Word = (0, DT_WORDBREAK); var Rect, CalcRect : TRect; DrawStyle : Longint; begin with Canvas do begin if not Transparent then begin Brush.Color := Self.Color; Brush.Style := bsSolid; FillRect(ClientRect); end; Brush.Style := bsClear; Rect := ClientRect; { DoDrawText takes care of BiDi alignments } DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[FAlignment]; { Calculate vertical layout } if FLayout <> tlTop then begin CalcRect := Rect; DoDrawText(CalcRect, DrawStyle or DT_CALCRECT); if FLayout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom) else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2); end; DoDrawText(Rect, DrawStyle); end; end; procedure TCustomStrokeLabel.SetAlignment(Value : TAlignment); begin if fAlignment <> Value then begin fAlignment := Value; Invalidate; end; end; procedure TCustomStrokeLabel.SetShowAccelChar(Value : Boolean); begin if FShowAccelChar <> Value then begin FShowAccelChar := Value; Invalidate; end; end; function TCustomStrokeLabel.GetPathColor : TColor; begin Result := fPathColor; end; procedure TCustomStrokeLabel.SetPathColor(aColor : TColor); begin if fPathColor <> aColor then begin fPathColor := aColor; Invalidate; end; end; procedure Register; begin RegisterComponents('Samples', [TStrokeLabel]); end; end. Код:
package stroke_d7; {$ALIGN ON} {$ASSERTIONS ON} {$BOOLEVAL OFF} {$DEBUGINFO ON} {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} {$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} {$REFERENCEINFO ON} {$SAFEDIVIDE OFF} {$STACKFRAMES OFF} {$TYPEDADDRESS OFF} {$VARSTRINGCHECKS ON} {$WRITEABLECONST ON} {$MINENUMSIZE 1} {$IMAGEBASE $400000} {$DESCRIPTION 'Stroke Label'} {$IMPLICITBUILD OFF} requires vcl70; contains Stroke in 'Stroke.pas'; end. Код:
package stroke_d2009; {$ALIGN ON} {$ASSERTIONS ON} {$BOOLEVAL OFF} {$DEBUGINFO ON} {$EXTENDEDSYNTAX ON} {$IMPORTEDDATA ON} {$IOCHECKS ON} {$LOCALSYMBOLS ON} {$LONGSTRINGS ON} {$OPENSTRINGS ON} {$OPTIMIZATION ON} {$OVERFLOWCHECKS OFF} {$RANGECHECKS OFF} {$REFERENCEINFO OFF} {$SAFEDIVIDE OFF} {$STACKFRAMES OFF} {$TYPEDADDRESS OFF} {$VARSTRINGCHECKS ON} {$WRITEABLECONST ON} {$MINENUMSIZE 1} {$IMAGEBASE $400000} {$DESCRIPTION 'Stroke Label'} {$IMPLICITBUILD ON} requires rtl, vcl; contains stroke in 'stroke.pas'; end. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 25.12.2011 в 03:57. |
Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Ankor (25.12.2011)
|
#20
|
|||
|
|||
Спасибо огромное за труды, правда мне в этом не разобраться(.
Я вот Ваш юнит сделал, вроде без ошибок компилируется, а как всё это хозяйство к Label-ам применить? Вот если можно, на моём примере покажите пожалуйста, а то я и за пол года не разбирусь. |
#21
|
||||
|
||||
Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
Этот пользователь сказал Спасибо angvelem за это полезное сообщение: | ||
Ankor (25.12.2011)
|
#22
|
|||
|
|||
Ну вроде установил, правда четкой обводки по контуру не получилось.
В любом случае огромное спасибо, наверно как-то допиливать придётся. |
#23
|
||||
|
||||
Несколько изменил вывод текста, для более чёткой прорисовки. Up.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#24
|
|||
|
|||
Спасибо.
Я тут нашел более крутой компонент, там и ширину тени, и цвета, и много чего можно сразу выставлять, да вот беда, именно нужного свойства - обводки текста по периметру(контуру) там нету. Наверняка там несложно одну функцию эту добавить, и было бы вообще супер. Если будет время и желание, посмотрите пожалуйста этот компонент. Буду признателен. Текст файла не уместился, поэтому вложение сделал. Последний раз редактировалось Ankor, 25.12.2011 в 17:38. |
#25
|
||||
|
||||
Есть совершенно бесплатные и очень симпатишные компоненты AlphaControls. Искомый вами эффект и еще куча всяких вкусностей там есть. Попробуйте.
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |
#26
|
||||
|
||||
Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#27
|
|||
|
|||
Спасибо и на этом. Вариант AlphaControls мне не подходит.
Кстати Вы последний свой исправленный пример с лучшей чёткостью сами то смотрели? Там если размер текста Size = 8, то весь текст закрашивается, без всякой обводки, вот я и нашел другой, более навороченный компонент, но это уже не важно. Сам я врядли конечно сделаю, если спецам даже иногда не удаётся. Спс за внимание. |
#28
|
||||
|
||||
Конечно смотрел. Беда в том, что используя функцию StrokeAndFillPath, хорошой читабельности можно добиться только при достаточно большом размере шрифта. Увы по-другому она не умеет. Я эту функцию использовал не для TLabel, а когда мне нужно было вывести сообщение привлекающее внимание - достаточно крупное.
P.S. Для маленьких шрифтов я делал не обводку, а тень - с выбором позиции, размера и цвета. Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. Последний раз редактировалось angvelem, 25.12.2011 в 22:26. |
#29
|
|||
|
|||
Ну да бог тогда с Вашей функцией, а Вы вот этот модуль можете мне доработать так, чтобы его как компонент (название - LabelF) можно было на делфи установить, со всеми свойствами обычного Label и там несколько новых, которые в модуле?
В какой раздел среды неважно, можно и в вкладку Samples. Код:
unit LabelShadowUnit; interface uses SysUtils, Classes, Graphics, Controls, StdCtrls; type TLabel2 = class(TLabel); TLabel = class(TLabel2) constructor Create(Owner : TComponent); override; destructor Destroy; override; //запуск деструктора procedure AddShadow(x: integer = 3; y: integer = 1; colorr : TColor = clBlack); procedure AddShadowText(widthh : byte = 1; colorr : TColor = clBlack); procedure ClearShadow; private shad : TList; end; implementation { TLabel } procedure TLabel.AddShadow(x : integer = 3; y : integer = 1; colorr : TColor = clBlack); var sh: TLabel; begin sh := TLabel.Create(self.Owner); with sh do begin WordWrap := self.WordWrap; Alignment := self.Alignment; Autosize := self.AutoSize; Parent := TWinControl(self.Parent); Font := self.Font; Top := self.Top + y; Left := self.Left + x; Width := self.width; Height := self.Height; Font.Color := colorr; Caption := self.Caption; Transparent := True; end; self.Transparent := True; self.BringToFront; shad.Add(sh); end; procedure TLabel.AddShadowText(widthh: byte; colorr : TColor); begin // прямоугольник AddShadow(widthh, 0, colorr); AddShadow(-1 * widthh, 0, colorr); AddShadow(0, widthh, colorr); AddShadow(0, -1 * widthh, colorr); // по бокам AddShadow(widthh, widthh, colorr); AddShadow(-1 * widthh, -1 * widthh, colorr); AddShadow(-1 * widthh, widthh, colorr); AddShadow(widthh, -1 * widthh, colorr); end; procedure TLabel.ClearShadow; var I : Integer; begin for I := 0 to shad.Count - 1 do TLabel(shad[i]).Destroy; shad.Clear; end; constructor TLabel.Create(Owner : TComponent); begin inherited Create(Owner); shad := TList.Create; end; destructor TLabel.Destroy; var I : Integer; begin for I := 0 to shad.Count - 1 do TLabel(shad[i]).Destroy; shad.Destroy; inherited Destroy; end; end. Последний раз редактировалось Ankor, 26.12.2011 в 01:03. |
#30
|
||||
|
||||
Добавь в модуль
Код:
procedure Register; begin RegisterComponents('Additional', [TShadowLabel]); end; Последний раз редактировалось YVitaliy, 19.04.2012 в 00:35. |
Этот пользователь сказал Спасибо YVitaliy за это полезное сообщение: | ||
Ankor (26.12.2011)
|