home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Midas / InternetExpress / InetXCustom / custlayout.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  6KB  |  221 lines
  1. unit CustLayout;
  2.  
  3. interface
  4.  
  5. uses Classes, HTTPApp, Db, DbClient, Midas,
  6.   XMLBrokr, WebComp, PagItems, MidItems;
  7.  
  8. type
  9.   TTitleLayoutGroup = class(TLayoutGroup)
  10.   private
  11.     FCaption: string;
  12.     FCaptionPosition: TCaptionPosition;
  13.     FCaptionAttributes: TCaptionAttributes;
  14.   protected
  15.     function ImplContent(Options: TWebContentOptions;
  16.       ParentLayout: TLayout): string; override;
  17.     procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  18.     function FormatCaption: string;
  19.   public
  20.     constructor Create(AOwner: TComponent); override;
  21.     destructor Destroy; override;
  22.   published
  23.     property CaptionPosition: TCaptionPosition
  24.       read FCaptionPosition write FCaptionPosition;
  25.     property Caption: string read FCaption write FCaption;
  26.     property CaptionAttributes: TCaptionAttributes
  27.       read FCaptionAttributes write SetCaptionAttributes;
  28.   end;
  29.  
  30.   TTitleDataForm = class(TDataForm)
  31.   private
  32.     FCaption: string;
  33.     FCaptionPosition: TCaptionPosition;
  34.     FCaptionAttributes: TCaptionAttributes;
  35.   protected
  36.     function ImplContent(Options: TWebContentOptions;
  37.       ParentLayout: TLayout): string; override;
  38.     procedure SetCaptionAttributes(const Value: TCaptionAttributes);
  39.     function FormatCaption: string;
  40.   public
  41.     constructor Create(AOwner: TComponent); override;
  42.     destructor Destroy; override;
  43.   published
  44.     property CaptionPosition: TCaptionPosition
  45.       read FCaptionPosition write FCaptionPosition;
  46.     property Caption: string read FCaption write FCaption;
  47.     property CaptionAttributes: TCaptionAttributes
  48.       read FCaptionAttributes write SetCaptionAttributes;
  49.   end;
  50.  
  51. implementation
  52.  
  53. uses sysutils;
  54.  
  55. { TTitleLayoutGroup }
  56.  
  57. constructor TTitleLayoutGroup.Create(AOwner: TComponent);
  58. begin
  59.   inherited;
  60.   FCaptionAttributes := TCaptionAttributes.Create(Self);
  61.   FCaptionAttributes.Style := 'text-align: center';
  62.   FCaptionPosition := capAbove;
  63. end;
  64.  
  65. destructor TTitleLayoutGroup.Destroy;
  66. begin
  67.   inherited;
  68.   FCaptionAttributes.Free;
  69. end;
  70.  
  71. function TTitleLayoutGroup.ImplContent(Options: TWebContentOptions;
  72.   ParentLayout: TLayout): string;
  73. var
  74.   FormLayout: TFormLayout;
  75.  
  76.   function FormatField(Field: TComponent): string;
  77.   var
  78.     Intf: IWebContent;
  79.   begin
  80.     if Field.GetInterface(IWebContent, Intf) then
  81.       Result := Format('%0:s'#13#10, [Intf.Content(Options, FormLayout)])
  82.   end;
  83.  
  84.   function Min(X, Y: Integer): Integer;
  85.   begin
  86.     Result := X;
  87.     if X > Y then Result := Y;
  88.   end;
  89. var
  90.   I: Integer;
  91.   Intf: ILayoutWebContent;
  92.   Attribs: string;
  93. begin
  94.   Result := '';
  95.   if WebFieldControls.Count = 0 then
  96.     Exit;
  97.   FormLayout := TFormLayout.Create(ParentLayout);
  98.   try
  99.     AddStringAttrib(Attribs, 'NAME', Name);
  100.     AddQuotedAttrib(Attribs, 'STYLE', Style);
  101.     AddQuotedAttrib(Attribs, 'CLASS', StyleRule);
  102.     AddCustomAttrib(Attribs, Custom);
  103.  
  104.     if DisplayColumns >= 1 then
  105.     begin
  106.       FormLayout.ColumnCount := Min(DisplayColumns, WebFieldControls.Count);
  107.       FormLayout.BreakButtons := True;
  108.     end;
  109.     FormLayout.TableHeader :=
  110.       Format('<TABLE %s>', [Attribs]);
  111.     for I := 0 to WebFieldControls.Count - 1 do
  112.     begin
  113.       Result := Result +
  114.         FormatField(WebFieldControls[I]);
  115.     end;
  116.     Result := Result + FormLayout.EndLayout;
  117.  
  118.     if Assigned(ParentLayout) and ParentLayout.GetInterface(ILayoutWebContent, Intf) then
  119.       if Caption = '' then
  120.         Result := Intf.LayoutTable(Result, GetLayoutAttributes)
  121.       else
  122.         Result := Intf.LayoutLabelAndField(FormatCaption, Result, GetLayoutAttributes);
  123.   finally
  124.     FormLayout.Free;
  125.   end;
  126. end;
  127.  
  128. function TTitleLayoutGroup.FormatCaption: string;
  129. var
  130.   Attribs: string;
  131. begin
  132.   AddQuotedAttrib(Attribs, 'STYLE', CaptionAttributes.Style);
  133.   AddCustomAttrib(Attribs, CaptionAttributes.Custom);
  134.   AddQuotedAttrib(Attribs, 'CLASS', CaptionAttributes.StyleRule);
  135.   GetLayoutAttributes.LabelAttributes := Attribs;
  136.   case CaptionPosition of
  137.     capLeft: GetLayoutAttributes.LabelPosition := lposLeft;
  138.     capRight: GetLayoutAttributes.LabelPosition := lposRight;
  139.     capAbove: GetLayoutAttributes.LabelPosition := lposAbove;
  140.     capBelow: GetLayoutAttributes.LabelPosition := lposBelow;
  141.   else
  142.     Assert(False, 'Unknown position');
  143.   end;
  144.   if Attribs <> '' then
  145.     Result := Format('<SPAN %0:s>%1:s</SPAN>', [Attribs, Caption])
  146.   else
  147.     Result := Caption;
  148. end;
  149.  
  150. procedure TTitleLayoutGroup.SetCaptionAttributes(
  151.   const Value: TCaptionAttributes);
  152. begin
  153.   FCaptionAttributes.Assign(Value);
  154. end;
  155.  
  156. { TTitleDataForm }
  157.  
  158. constructor TTitleDataForm.Create(AOwner: TComponent);
  159. begin
  160.   inherited;
  161.   FCaptionAttributes := TCaptionAttributes.Create(Self);
  162.   FCaptionAttributes.Style := 'text-align: center';
  163.   FCaptionPosition := capAbove;
  164. end;
  165.  
  166. destructor TTitleDataForm.Destroy;
  167. begin
  168.   inherited;
  169.   FCaptionAttributes.Free;
  170. end;
  171.  
  172. function TTitleDataForm.FormatCaption: string;
  173. var
  174.   Attribs: string;
  175. begin
  176.   AddQuotedAttrib(Attribs, 'STYLE', CaptionAttributes.Style);
  177.   AddCustomAttrib(Attribs, CaptionAttributes.Custom);
  178.   AddQuotedAttrib(Attribs, 'CLASS', CaptionAttributes.StyleRule);
  179.   GetLayoutAttributes.LabelAttributes := Attribs;
  180.   case CaptionPosition of
  181.     capLeft: GetLayoutAttributes.LabelPosition := lposLeft;
  182.     capRight: GetLayoutAttributes.LabelPosition := lposRight;
  183.     capAbove: GetLayoutAttributes.LabelPosition := lposAbove;
  184.     capBelow: GetLayoutAttributes.LabelPosition := lposBelow;
  185.   else
  186.     Assert(False, 'Unknown position');
  187.   end;
  188.   if Attribs <> '' then
  189.     Result := Format('<SPAN %0:s>%1:s</SPAN>', [Attribs, Caption])
  190.   else
  191.     Result := Caption;
  192. end;
  193.  
  194.  
  195. function TTitleDataForm.ImplContent(Options: TWebContentOptions;
  196.   ParentLayout: TLayout): string;
  197. var
  198.   Intf: ILayoutWebContent;
  199. begin
  200.   Result := inherited ImplContent(Options, ParentLayout);
  201.   if Caption <> '' then
  202.   begin
  203.     with TFormLayout.Create(ParentLayout) do
  204.     try
  205.       if GetInterface(ILayoutWebContent, Intf) then
  206.         Result := Intf.LayoutLabelAndField(FormatCaption, Result, GetLayoutAttributes);
  207.     finally
  208.       Result := Result + EndLayout;
  209.       Free;
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure TTitleDataForm.SetCaptionAttributes(
  215.   const Value: TCaptionAttributes);
  216. begin
  217.   FCaptionAttributes.Assign(Value);
  218. end;
  219.  
  220. end.
  221.