Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 641

•  TDictionary Custom Sort  6 646

•  Fast Watermark Sources  6 423

•  3D Designer  9 364

•  Sik Screen Capture  6 752

•  Patch Maker  7 140

•  Айболит (remote control)  7 154

•  ListBox Drag & Drop  6 010

•  Доска для игры Реверси  97 601

•  Графические эффекты  7 337

•  Рисование по маске  6 625

•  Перетаскивание изображений  5 495

•  Canvas Drawing  5 873

•  Рисование Луны  5 596

•  Поворот изображения  5 103

•  Рисование стержней  3 674

•  Paint on Shape  2 906

•  Генератор кроссвордов  3 803

•  Головоломка Paletto  3 054

•  Теорема Монжа об окружностях  3 864

•  Пазл Numbrix  2 546

•  Заборы и коммивояжеры  3 258

•  Игра HIP  2 228

•  Игра Go (Го)  2 163

•  Симулятор лифта  2 540

•  Программа укладки плитки  2 178

•  Генератор лабиринта  2 679

•  Проверка числового ввода  2 328

•  HEX View  2 663

•  Физический маятник  2 295

 
скрыть

3D-рамка для текстовых компонентов



Вспоминаю что надо сходить в магазин за продуктаим - беру деньги смотрю нехватает ,а сам уже автоматически думаю надо взять отгрузочный файл - найти байты денег и сделать себе побольше...

Один из примеров создания текстового компонента с трехмерной декоративной контурной рамкой (для создания компонента потребовалось около получаса. Он демонстрирует только принцип получения рамки. Я не стал колдовать над свойствами типа ParentFont..., т.к. это заняло бы еще немало времени и места).


unit IDSLabel;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs,

  ExtCtrls;

type

  TIDSLabel = class(TBevel)
  private
    { Private declarations }
    FAlignment: TAlignment;
    FCaption: string;
    FFont: TFont;
    FOffset: Byte;

    FOnChange: TNotifyEvent;

    procedure SetAlignment(taIn: TAlignment);
    procedure SetCaption(const strIn: string);
    procedure SetFont(fntNew: TFont);
    procedure SetOffset(bOffNew: Byte);
  protected
    { Protected declarations }
    constructor Create(compOwn: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  public
    { Public declarations }
  published
    { Published declarations }
    property Alignment: TAlignment read FAlignment write SetAlignment default
      taLeftJustify;
    property Caption: string read FCaption write SetCaption;
    property Font: TFont read FFont write SetFont;
    property Offset: Byte read FOffset write SetOffset;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

constructor TIDSLabel.Create;
begin

  inherited Create(compOwn);

  FFont := TFont.Create;
  with compOwn as TForm do
    FFont.Assign(Font);

  Offset := 4;
  Height := 15;
end;

destructor TIDSLabel.Destroy;
begin

  FFont.Free;

  inherited Destroy;
end;

procedure TIDSLabel.Paint;
var

  wXPos, wYPos: Word;
begin

  {Рисуем рамку}
  inherited Paint;

  {Назначаем шрифт}
  Canvas.Font.Assign(Font);

  {Вычисляем вертикальную позицию}
  wYPos := (Height - Canvas.TextHeight(Caption)) div 2;

  {Вычисляем горизонтальную позицию}
  wXPos := Offset;
  case Alignment of
    taRightJustify: wXPos := Width - Canvas.TextWidth(Caption) - Offset;
    taCenter: wXPos := (Width - Canvas.TextWidth(Caption)) div 2;
  end;
  Canvas.Brush := Parent.Brush;
  Canvas.TextOut(wXPos, wYPos, Caption);

end;

procedure TIDSLabel.SetAlignment;
begin

  FAlignment := taIn;
  Invalidate;
end;

procedure TIDSLabel.SetCaption;
begin
  FCaption := strIn;

  if Assigned(FOnChange) then
    FOnChange(Self);

  Invalidate;
end;

procedure TIDSLabel.SetFont;
begin

  FFont.Assign(fntNew);
  Invalidate;
end;

procedure TIDSLabel.SetOffset;
begin

  FOffset := bOffNew;
  Invalidate;
end;

end.