Я делал контроллеры внешнего вида органов управления для VCL и .NET.
Потом забил, времени мало.

А кто-нибудь думал над созданием компонентов - контроллеров?

Что бы создать DBTreeView как правило делают наследника от TCustomTreeView.  А может сделать контроллер, который позволит расширить функционально стандартный компонент? Он будет не визуальным. Конечно! Он же не меняет принципа отображения информации... Другой пример контроллер Label-Edit. Это чтобы метки и поля редактирования существовали вместе.

Суть - максимально использовать базовые компоненты и композицию как альтернативу наследованию.

Удачи.

у JVCL лицензия MPL

Вот вам первый компонент из моей библиотеки.

Модифицированный TImage.
Бывает часто что нам нужен красивый задний фон на форме, как например на веб-страницах. Но это обычно маленький квадратик-картинка, который в притык продублирован по всей поверхности окна.
Такой метод выгоден тем что, он занимает мало места в программе.

Предлагаю компонент для королевства TmImage, имеющий свойство Fill,
при Fill:= true вы получете то что я сказал выше, т.е. картинка будет динамически прорисовываться по всему размеру TmImage,
а при Fill:= false, будет вести себя по старому.

Исходник:

unit mImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus;

type
  TmImage = class(TGraphicControl)
  private
    FFill: Boolean; {9}
    FPicture: TPicture;
    FOnProgress: TProgressEvent;
    FStretch: Boolean;
    FCenter: Boolean;
    FIncrementalDisplay: Boolean;
    FTransparent: Boolean;
    FDrawing: Boolean;
    function GetCanvas: TCanvas;
    procedure PictureChanged(Sender: TObject);
    procedure SetCenter(Value: Boolean);
    procedure SetPicture(Value: TPicture);
    procedure SetStretch(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
    procedure SetFill(Value: Boolean); {9}
  protected
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    function DestRect: TRect;
    function DoPaletteChange: Boolean;
    function GetPalette: HPALETTE; override;
    procedure Paint; override;
    procedure Progress(Sender: TObject; Stage: TProgressStage;
      PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TCanvas read GetCanvas;
  published
    property Fill: Boolean read FFill write SetFill default False; {9}
    property Align;
    property Anchors;
    property AutoSize;
    property Center: Boolean read FCenter write SetCenter default False;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
    property ParentShowHint;
    property Picture: TPicture read FPicture write SetPicture;
    property PopupMenu;
    property ShowHint;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
    property OnStartDock;
    property OnStartDrag;
  end;


procedure Register;

implementation

uses Consts;

procedure Register;
begin
  RegisterComponents('Kingdom', [TmImage]);
end;

procedure TmImage.SetFill(Value: Boolean);
begin
if FFill <> Value then
  begin
  FFill:= Value;
  PictureChanged(Self);
  end;
end;

procedure TmImage.Paint;
var
  Save: Boolean;
  mRect: TRect;
  i, j, ii ,jj, iHeight, iWidth: Integer;
begin
  if csDesigning in ComponentState then
    with inherited Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  Save := FDrawing;
  FDrawing := True;
  try
    with inherited Canvas do
    if not Fill then
      StretchDraw(DestRect, Picture.Graphic)
    else
      begin
      iHeight:= DestRect.Bottom- DestRect.Top;
      iWidth:= DestRect.Right-  DestRect.Left;
      jj:= 0;
      while (jj*iHeight)< Height do Inc(jj);
      ii:= 0;
      while (ii*iWidth)< Width do Inc(ii);
      for j:= 0 to jj do
        for i:= 0 to ii do
        begin
          mRect.Top:= j*iHeight;
          mRect.Bottom:= (j+1)*iHeight;
          mRect.Left:= i*iWidth;
          mRect.Right:= (i+1)*iWidth;
          StretchDraw(mRect, Picture.Graphic);
        end;
      end;
  finally
    FDrawing := Save;
  end;
end;

constructor TmImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FPicture.OnProgress := Progress;
  Height := 105;
  Width := 105;
end;

destructor TmImage.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

function TmImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if FPicture.Graphic <> nil then
    Result := FPicture.Graphic.Palette;
end;

function TmImage.DestRect: TRect;
begin
  if Stretch then
    Result := ClientRect
  else if Center then
    Result := Bounds((Width - Picture.Width) div 2, (Height - Picture.Height) div 2,
      Picture.Width, Picture.Height)
  else
    Result := Rect(0, 0, Picture.Width, Picture.Height);
end;
{
procedure TImage.Paint;
var
  Save: Boolean;
begin
  if csDesigning in ComponentState then
    with inherited Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;
  Save := FDrawing;
  FDrawing := True;
  try
    with inherited Canvas do
      StretchDraw(DestRect, Picture.Graphic);
  finally
    FDrawing := Save;
  end;
end;
}
function TmImage.DoPaletteChange: Boolean;
var
  ParentForm: TCustomForm;
  Tmp: TGraphic;
begin
  Result := False;
  Tmp := Picture.Graphic;
  if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and
    (Tmp.PaletteModified) then
  begin
    if (Tmp.Palette = 0) then
      Tmp.PaletteModified := False
    else
    begin
      ParentForm := GetParentForm(Self);
      if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
      begin
        if FDrawing then
          ParentForm.Perform(wm_QueryNewPalette, 0, 0)
        else
          PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
        Result := True;
        Tmp.PaletteModified := False;
      end;
    end;
  end;
end;

procedure TmImage.Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
  if FIncrementalDisplay and RedrawNow then
  begin
    if DoPaletteChange then Update
    else Paint;
  end;
  if Assigned(FOnProgress) then FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;

function TmImage.GetCanvas: TCanvas;
var
  Bitmap: TBitmap;
begin
  if Picture.Graphic = nil then
  begin
    Bitmap := TBitmap.Create;
    try
      Bitmap.Width := Width;
      Bitmap.Height := Height;
      Picture.Graphic := Bitmap;
    finally
      Bitmap.Free;
    end;
  end;
  if Picture.Graphic is TBitmap then
    Result := TBitmap(Picture.Graphic).Canvas
  else
    raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;

procedure TmImage.SetCenter(Value: Boolean);
begin
  if FCenter <> Value then
  begin
    FCenter := Value;
    PictureChanged(Self);
  end;
end;

procedure TmImage.SetPicture(Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TmImage.SetStretch(Value: Boolean);
begin
  if Value <> FStretch then
  begin
    FStretch := Value;
    PictureChanged(Self);
  end;
end;

procedure TmImage.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    PictureChanged(Self);
  end;
end;

procedure TmImage.PictureChanged(Sender: TObject);
var
  G: TGraphic;
begin
  if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
    SetBounds(Left, Top, Picture.Width, Picture.Height);
  G := Picture.Graphic;
  if G <> nil then
  begin
    if not ((G is TMetaFile) or (G is TIcon)) then
      G.Transparent := FTransparent;
    if (not G.Transparent) and (Stretch or (G.Width >= Width)
      and (G.Height >= Height)) then
      ControlStyle := ControlStyle + [csOpaque]
    else
      ControlStyle := ControlStyle - [csOpaque];
    if DoPaletteChange and FDrawing then Update;
  end
  else ControlStyle := ControlStyle - [csOpaque];
  if not FDrawing then Invalidate;
end;

function TmImage.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  if not (csDesigning in ComponentState) or (Picture.Width > 0) and
    (Picture.Height > 0) then
  begin
    if Align in [alNone, alLeft, alRight] then
      NewWidth := Picture.Width;
    if Align in [alNone, alTop, alBottom] then
      NewHeight := Picture.Height;
  end;
end;


end.


Muralimov Murat

2Erik Ivanov

Кстати, а какая именно "политика JEDI"? Нигде по-русски она не встречалась? Ибо у коллеги в конторе после показа JEDI CL возникло сразу утверждение-вопрос: "Я это хочу! Какая у него лицензия?"

Библиотека это хорошо. Я уже три года немогу найти нормальный DbLookupComboBox. Првда особо неискал, частично удовлетворяет Rx или старый компонент оставшийся у меня со времен Delphi 2. А теперь после вхождения Rx в JEDI незнаю, что делать. Свой компонент писать не хочится, поскольку в других почти все есть. Вот каша и получается QuantumGrid+RxLib+Sap(от старой разработки)+свои невизуальные компоненты+EhGrid Free.
Если Andrey возмется и напишет рамкох JEDI нужный мне компенет и его неустроит политика JEDI. ТО можно дальше вести разговор. Я обязуюсь его протестировать.

2Арни:

Да никто. "Чукча не читатель, чукча писатель" :)

Интересно, все ли хотящие "написать своё, ибо нету и хотим", прочитали (нет, хотя бы посмотрели) даже не JEDI VCL, а хотя бы только help от JEDI CODE LIBRARY ?

2(Dark S/L):

Дык присоединяйся к JEDI, какая проблема :)
http://jvcl.sourceforge.net

Если хоть один человек захочет это делать(библиотеку ххх VCL), то я готов к созданию проекта хоть завтра. У меня много свободного времени. Одни пишут, вторые тестируют, третьи приводят это все в удобный для использования вид, пишут документацию и т.д. Мыслю я, это должно быть не только набор компонентов, но и что-то вроде STL. Я бы хотел увидеть в ней:
1) Арифметика длинных чисел, операции с матрицами.
2) Парсинг, регулярные выражения.
3) Структуры данных(разного вида деревья, очереди, хеш-таблицы и т.п.- эффективно реализованы!!
4) Компрессия, криптография.
5) Работа с железом - тот же СОМ-порт, звуковуха и пр.
6) Хидеры DirectX не помешали бы.(хоть бы и третьесторонние)