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

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

•  TDictionary Custom Sort  6 514

•  Fast Watermark Sources  6 303

•  3D Designer  9 249

•  Sik Screen Capture  6 638

•  Patch Maker  7 015

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

•  ListBox Drag & Drop  5 896

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

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

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

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

•  Canvas Drawing  5 761

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

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

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

•  Paint on Shape  2 817

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

•  Головоломка Paletto  2 974

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

•  Пазл Numbrix  2 492

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

•  Игра HIP  2 140

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

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

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

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

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

•  HEX View  2 600

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

 
скрыть

Delphi Sources

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.