fdcmppal.pas.svn-base

TFormDesigner allows you move and resize any control on your form. You need not prepare your form to

(*  GREATIS FORM DESIGNER PRO                 *)
(*  unit version 3.50.001                     *)
(*  Copyright (C) 2001-2003 Greatis Software  *)
(*  http://www.greatis.com/formdes.htm        *)
(*  [e-mail]                        *)

unit FDCmpPal;

interface

uses Windows, Classes, Controls, Buttons, Graphics, ComCtrls;

type
  TPalettePage = class(TTabSheet)
  private
    procedure OnPageShow(Sender: TObject);
    procedure OnPageResize(Sender: TObject);

  public
    procedure AfterConstruction; override;
    procedure Relayout; virtual;
  end;
  
  TPaletteButton = class(TSpeedButton)
  private
    FComponentClass: TComponentClass;
  public
    property ComponentClass: TComponentClass read FComponentClass write FComponentClass;
  end;

function CreatePaletteButton(AParent: TWinControl; AClass: TComponentClass; ALeft,ATop: Integer; ClickEvent: TNotifyEvent): TPaletteButton;
function CreatePalettePage(APageControl: TPageControl; ACaption: string; AClasses: array of TComponentClass; ClickEvent: TNotifyEvent): TTabSheet;
procedure EditMode(APageControl: TPageControl);

implementation

{$R FDCMPPAL.RES}
{$R STD.RES}

procedure TPalettePage.AfterConstruction;
begin
  inherited;

  Self.OnShow := OnPageShow;
  Self.OnResize := OnPageResize;
end;

procedure TPalettePage.OnPageShow(Sender: TObject);
begin
  inherited;

  Relayout;
end;

procedure TPalettePage.OnPageResize(Sender: TObject);
begin
  inherited;

  Relayout;
end;

procedure TPalettePage.Relayout;
var
  I: Integer;
  count: Integer;
  W, H: Integer;
  row: Integer;
begin
  count := 0;
  for I := 0 to Self.ControlCount - 1 do    // Iterate
  begin
    if Self.Controls[I] is TPaletteButton then
    begin
      with TPaletteButton(Self.Controls[I]) do
      begin
        W := Width;
        H := Height;
        row := (Self.Width div W);

        Top := (count div row)*H;
        Left := (count mod row)*W+4;

        Inc(count);
      end;
    end;
  end;    // for
end;

function CreatePaletteButton(AParent: TWinControl; AClass: TComponentClass; ALeft,ATop: Integer; ClickEvent: TNotifyEvent): TPaletteButton;
  function GetGlyphHandle(AClass: TClass): Integer;
  var
    AClassName: string;
  begin
    if Assigned(AClass) then
    begin
      AClassName := AClass.ClassName;
      Result := LoadBitmap(HInstance, PChar(AClassName));

      if Result=0 then
      begin
        Result := GetGlyphHandle(AClass.ClassParent);
      end;
    end;
  end;
var
  AClassName: string;
begin
  Result:=TPaletteButton.Create(AParent);
  with Result do
  begin
    ComponentClass:=AClass;
    if Assigned(ComponentClass) then
    begin
      RegisterClass(ComponentClass);
      AClassName:=ComponentClass.ClassName;

      with Glyph do
      begin
        //ComponentClass.ClassParent
        //Handle:=LoadBitmap(HInstance,PChar(AClassName));
        Handle := GetGlyphHandle(ComponentClass);
        if Handle=0 then Handle:=LoadBitmap(HInstance,'TCOMPONENT');
      end;

      Hint:=Copy(AClassName,3,Pred(Length(AClassName)));
    end
    else Glyph.Handle:=LoadBitmap(HInstance,'EDITMODE');
    Left:=ALeft;
    Top:=ATop;
    Width:=28;
    Height:=28;
    Flat:=True;
    GroupIndex:=1;
    if not Assigned(ComponentClass) then Down:=True;
    ShowHint:=True;
    Parent:=AParent;
    OnClick:=ClickEvent;
  end;
end;

function CreatePalettePage(APageControl: TPageControl; ACaption: string; AClasses: array of TComponentClass; ClickEvent: TNotifyEvent): TTabSheet;
var
  i,W: Integer;
begin
  Result:=TPalettePage.Create(APageControl);
  with Result do
  begin
    W:=CreatePaletteButton(Result,nil,0,0,ClickEvent).Width;
    for i:=Low(AClasses) to High(AClasses) do
      CreatePaletteButton(Result,AClasses[i],Succ(i)*W+4,0,ClickEvent);
    Caption:=ACaption;
    PageControl:=APageControl;
  end;
end;

procedure EditMode(APageControl: TPageControl);
var
  i: Integer;
begin
  with APageControl do
    for i:=0 to Pred(PageCount) do
      (Pages[i].Controls[0] as TPaletteButton).Down:=True;
end;

end.