こんにちは、佐藤　充男です。



☆説明
　TCustomControlを継承した種コンポーネントです。
登録しても何も出来ませんが、雛型として使えると思います。
肥料（機能追加）と水（継承）と日光（アイデア）で、種を育ててください(^^;

☆補足
　・Delphi3/4、C++Builder3で動作確認。

======================================================================
unit SeedCompo;

//----------------------------------------------------------------------
// TSeedCompo  TCustomControlを継承した種コンポーネント
//----------------------------------------------------------------------

interface

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

type
  TScrollStyle = (ssNone, ssHorizontal, ssVertical, ssBoth);

  TSeedCompo = class(TCustomControl)
  private
    { Private 宣言 }
    FBorderStyle: TBorderStyle;
    FScrollBars: TScrollStyle;

    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetScrollBars(Value: TScrollStyle);

    procedure CMCtl3DChanged(var msg: TMessage); message CM_CTL3DCHANGED;
    procedure WMSetFocus(var msg: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSize(var msg: TWMSize); message WM_SIZE;
    procedure WMGetDlgCode(var msg:TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMHScroll(var msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var msg: TWMVScroll); message WM_VSCROLL;
  protected
    { Protected 宣言 }
    procedure SetParent(AParent: TWinControl); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    { Public 宣言 }
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
  published
    { Published 宣言 }
    property BorderStyle: TBorderStyle
      read FBorderStyle write SetBorderStyle default bsSingle;
    property Ctl3D;
    property ScrollBars: TScrollStyle
      read FScrollBars write SetScrollBars default ssNone;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSeedCompo]);
end;

//----------------------------------------------------------------------
constructor TSeedCompo.Create(AOwner : TComponent);
begin
  Inherited Create( AOwner );
  // ここに初期化処理を記述
  FBorderStyle := bsSingle;
  FScrollBars := ssNone;
  SetBounds(Left,Top,121, 20);    // サンプル
end;

procedure TSeedCompo.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if AParent <> nil then
  begin
    // ここにCanvas 周りの初期化処理を記述
    Canvas.Font.Assign(Font);    // サンプル
    Color := clWindow;           // サンプル
  end;
end;

procedure TSeedCompo.CreateParams(var Params: TCreateParams);
const
{$IFDEF VER100}  // Delphi3
  BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
  ScrollBar: array[TScrollStyle] of LongInt = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
{$ENDIF}
{$IFDEF VER110}  // C++Builder3
  BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
  ScrollBar: array[TScrollStyle] of LongInt = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
{$ENDIF}
{$IFDEF VER120}  // Delphi4
  BorderStyles: array[TBorderStyle] of Longword = (0, WS_BORDER);
  ScrollBar: array[TScrollStyle] of Longword = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
{$ENDIF}
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle] or ScrollBar[FScrollBars];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;

destructor TSeedCompo.Destroy;
begin
  // ここに終了処理を記述
  inherited Destroy;
end;

procedure TSeedCompo.Paint;
var
  DrawRect: TRect;
begin
  inherited Paint;
  // ここに描画処理を記述
  Canvas.Brush.Color := Color;   // サンプル
  Canvas.FillRect(DrawRect);     // サンプル
end;

//----------------------------------------------------------------------
procedure TSeedCompo.CMCtl3DChanged(var msg: TMessage);
begin
  inherited;
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
end;

procedure TSeedCompo.WMSetFocus(var msg: TWMSetFocus);
begin
  inherited;
  // ここにフォーカスを得たときの処理を記述
end;

procedure TSeedCompo.WMKillFocus(var msg: TWMKillFocus);
begin
  inherited;
  // ここにフォーカスを失ったときの処理を記述
end;

procedure TSeedCompo.WMSize(var msg: TWMSize);
begin
  inherited;
  RePaint;
end;

procedure TSeedCompo.WMGetDlgCode(var msg:TWMGetDlgCode);
begin
  inherited;
  Msg.Result := DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTALLKEYS;
end;

procedure TSeedCompo.WMHScroll(var msg: TWMHScroll);
begin
  inherited;
  // ここに水平スクロールの処理を記述
end;

procedure TSeedCompo.WMVScroll(var msg: TWMVScroll);
begin
  inherited;
  // ここに垂直スクロールの処理を記述
end;

//----------------------------------------------------------------------
procedure TSeedCompo.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TSeedCompo.SetScrollBars(Value: TScrollStyle);
begin
  if FScrollBars <> Value then
  begin
    FScrollBars := Value;
    RecreateWnd;
  end;
end;

end.
======================================================================

                              98/12/17(木) 00:56pm  LDM03756 佐藤　充男

Original document by 佐藤　充男　　　氏 ID:(LDM03756)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。