Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/d3456/KBMWABD.ZIP/WABD_EditTable.pas

Pascal/Delphi Source File | 2001-07-15 | 22KB | 710 lines

unit WABD_EditTable;

{$I kbmWABD.inc}

interface

uses SysUtils, Classes, WABD_Objects,Dialogs,DB,Graphics;

type
   TWABD_EditTable = class;
   TWABD_DBEditTable = class;

   // Derive from TWABD_FormSection_Base insead of just TWABD_FormSection
   // so that the user can NOT edit the child controls in the WABD Form
   // designer
   TWABD_OnResizeTable = procedure(Sender:TObject) of object;
   TWABD_OnRenderTable = procedure(Sender:TObject) of object;
   TWABD_OnRenderTableCell = procedure(Sender:TObject; Cell:TWABD_SectionObject; Col,Row:integer) of object;
   TWABD_OnRenderTableHeaderCell = procedure(Sender:TObject; HeaderCell:TWABD_Label; Col:integer) of object;
   TWABD_InternalTable = class(TWABD_FormSection_Grid)
   protected
      FCols       : integer;
      FRows       : integer;
      FHeaders    : TList;
      FCells      : TList;
      FHeader     : boolean;
      FColWidths  : array [0..254] of integer;
      FColOfs     : array [0..254] of integer;
      FOnResize   :TWABD_OnResizeTable;
      FOnRender   :TWABD_OnRenderTable;
      FOnRenderCell:TWABD_OnRenderTableCell;
      FOnRenderHeaderCell:TWABD_OnRenderTableHeaderCell;

      function    GetCellObject(Col, Row: integer): TWABD_SectionObject;
      function    GetHeader(Col: integer): string;
      procedure   SetHeader(Col: integer; const Value: string);
      function    GetColWidth(Col:integer):integer;
      procedure   SetColWidth(Col:integer; AWidth:integer);

      procedure   SetHeaderShown(Shown:boolean);
      function    GetHeaderObject(Col:integer): TWABD_Label;
      procedure   Resize;

      function    CreateCell(Col,Row:integer):TWABD_SectionObject; virtual; abstract;
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      function    Object_To_HTML:string; override;
      property    Headers[Col: integer]: string read GetHeader write SetHeader;
      property    HeaderObjects[Col:integer]:TWABD_Label read GetHeaderObject;
      property    CellObjects[Col,Row:integer]:TWABD_SectionObject read GetCellObject;
      property    ColWidth[Col:integer]:integer read GetColWidth write SetColWidth;
   published
      property    OnResize:TWABD_OnResizeTable read FOnResize write FOnResize;
      property    OnRender:TWABD_OnRenderTable read FOnRender write FOnRender;
      property    OnRenderCell:TWABD_OnRenderTableCell read FOnRenderCell write FOnRenderCell;
      property    OnRenderHeaderCell:TWABD_OnRenderTableHeaderCell read FOnRenderHeaderCell write FOnRenderHeaderCell;
      property    Header:boolean read FHeader write SetHeaderShown;
   end;

   TWABD_EditTable = class(TWABD_InternalTable)
   protected
      FEditSize   : integer;

      function    GetCols:integer;
      function    GetRows:integer;
      procedure   SetCols(NewCols: integer);
      procedure   SetRows(NewRows: integer);

      function    CreateCell(Col,Row:integer):TWABD_SectionObject; override;
      function    GetCell(Col, Row: integer): string;
      procedure   SetCell(Col, Row: integer; const Value: string);
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      property    Cells[Col,Row: integer]: string read GetCell write SetCell;
   published
      property    Cols: integer read GetCols write SetCols;
      property    Rows: integer read GetRows write SetRows;
      property    EditSize: integer read FEditSize write FEditSize;
   end;

   TWABD_DBEditTable_DataLink = class(TDataLink)
   private
      FOnActiveChanged:TNotifyEvent;
      FOnDatasetChanged:TNotifyEvent;
      FOnLayoutChanged:TNotifyEvent;
      FEditTable:TWABD_DBEditTable;
   protected
      procedure DatasetChanged; override;
      procedure ActiveChanged; override;
      procedure LayoutChanged; override;
   published
      property OnActiveChanged:TNotifyEvent read FOnActiveChanged write FOnActiveChanged;
      property OnDatasetChanged:TNotifyEvent read FOnDatasetChanged write FOnDatasetChanged;
      property OnLayoutChanged:TNotifyEvent read FOnLayoutChanged write FOnLayoutChanged;
   end;

   TWABD_DBEditTable = class(TWABD_EditTable)
   protected
      FDataLink   : TWABD_DBEditTable_DataLink;
      FActiveRec  : integer;
      FRecordCount: integer;
      FCalcPages  : boolean;
      FRowIDs     : TList;
      FShowNavigator:boolean;
      procedure   RecountRecords(Sender:TObject);
      function    GetDataSource: TDataSource;
      procedure   SetDataSource(NewDataSource: TDataSource);
      procedure   SetShowNavigator(Shown:boolean);
      procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
      function    IsLinked:boolean;
      procedure   Populate(FromRecord:integer);
      function    CreateCell(Col,Row:integer):TWABD_SectionObject; override;
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      function    Object_To_HTML:string; override;
   published
      property    DataSource: TDataSource read GetDataSource write SetDataSource;
      property    ShowNavigator:boolean read FShowNavigator write SetShowNavigator;
   end;

implementation

// TWABD_InternalTable.
constructor TWABD_InternalTable.Create(AOwner: TComponent);
begin
     inherited;
     FCells     := TList.Create;
     FHeaders   := TList.Create;
     GridX      := 70;
     GridY      := 25;
     CellBorder := 0;
end;

destructor TWABD_InternalTable.Destroy;
var
   i:integer;
begin
     for i:=0 to FCells.count-1 do
         TWABD_SectionObject(FCells.Items[i]).free;
     for i:=0 to FHeaders.count-1 do
         TWABD_SectionObject(FHeaders.Items[i]).free;
     FCells.Free;
     FHeaders.Free;
     inherited;
end;

procedure TWABD_InternalTable.SetHeaderShown(Shown:boolean);
begin
     FHeader:=Shown;
     Resize;
end;

function TWABD_InternalTable.Object_To_HTML:string;
var
   x,y,n,h:integer;
begin
     // Determine columns widths.
     for x:=0 to FCols-1 do
     begin
          n:=0;

          // Check if header width bigger than predetermined.
          if (FHeader) then
             with TWABD_SectionObject(FHeaders[x]) do
                  if Width>n then n:=Width;

          // Check if cell widths bigger than predetermined.
          for y:=0 to FRows-1 do
              with TWABD_SectionObject(FCells[x*FRows+y]) do
                   if Width>n then n:=Width;

          FColWidths[x]:=n;
     end;

     // Let appl. programmer change defaults.
     if assigned(FOnRenderHeaderCell) then
        for x:=0 to FCols-1 do
            FOnRenderHeaderCell(self,FHeaders.Items[x],x);

     if assigned(FOnRenderCell) then
        for x:=0 to FCols-1 do
            for y:=0 to FRows-1 do
                FOnRenderCell(self,FCells.Items[x*FRows + y],x,y);

     if assigned(FOnRender) then FOnRender(self);

     // Recalculate col offsets.
     n:=0;
     for x:=0 to FCols-1 do
     begin
          FColOfs[x]:=n;
          h:=0;

          // Set header ofs if any header.
          if (FHeader) then
             with TWABD_SectionObject(FHeaders[x]) do
             begin
                  LeftPos:=n;
                  TopPos:=h;
                  Width:=FColWidths[x];
                  inc(h,GridY);
             end;

          // Update cell positions.
          for y:=0 to FRows-1 do
              with TWABD_SectionObject(FCells[x*FRows+y]) do
              begin
                   LeftPos:=n;
                   TopPos:=h;
                   inc(h,GridY);
              end;

          n:=n+FColWidths[x];
     end;

     Result:=inherited Object_To_HTML;
end;

function TWABD_InternalTable.GetCellObject(Col, Row: integer): TWABD_SectionObject;
begin
     if (Col<0) or (Col>=FCols) or (Row<0) or (Row>=FRows) then raise Exception.CreateFmt('Col or Row out of range. (Col=%d,Row=%d)',[Col,Row]);
     Result := FCells.Items[Col * FRows + Row];
end;

function TWABD_InternalTable.GetHeader(Col:integer):string;
var
   nl:TWABD_Label;
begin
     nl:=FHeaders.Items[Col];
     Result:=nl.Caption;
end;

procedure TWABD_InternalTable.SetHeader(Col:integer; const Value:string);
var
   nl:TWABD_Label;
begin
     nl:=FHeaders.Items[Col];
     nl.Caption:=Value;
end;

function TWABD_InternalTable.GetColWidth(Col:integer):integer;
begin
     if (Col<0) or (Col>254) then raise Exception.CreateFmt('Column number out of range. Col=%d',[Col]);
     Result:=FColWidths[Col];
end;

procedure TWABD_InternalTable.SetColWidth(Col:integer; AWidth:integer);
begin
     if (Col<0) or (Col>254) then raise Exception.CreateFmt('Column number out of range. Col=%d',[Col]);
     FColWidths[Col]:=AWidth;
end;

function TWABD_InternalTable.GetHeaderObject(Col:integer):TWABD_Label;
begin
     Result := FHeaders.Items[Col];
end;

procedure TWABD_InternalTable.Resize;
var
   i, x, y : integer;
   no      : TWABD_SectionObject;
   nl      : TWABD_Label;
begin
     // Remove all headers.
     for i := FHeaders.Count-1 downto 0 do
     begin
          TObject(FHeaders[i]).Free;
          FHeaders.Delete(i);
     end;

     // Remove all cells.
     for i := FCells.Count-1 downto 0 do
     begin
          TObject(FCells[i]).Free;
          FCells.Delete(i);
     end;

     // Should a header line be generated?
     if (FHeader) then
     begin
          for x:=0 to FCols-1 do
          begin
               nl:=TWABD_Label.Create(Self);
               nl.Parent:=Self;
               nl.Name := Format('%s_Hdr_x%d',[Name,x]);
               nl.Width:=GridX-1;
               nl.Height:=GridY-1;
               nl.Caption:='COL '+inttostr(x);
               FHeaders.Add(nl);
          end;
     end;

     // Generate cells.
     for x := 0 to FCols-1 do begin
        for y := 0 to FRows-1 do begin
           no := CreateCell(x,y);
           if no=nil then Raise Exception.CreateFmt('Cell x=%d,y=%d is nil.',[x,y]);
           no.Parent  := Self;
           no.Name    := Format('%s_x%d_y%d', [Name, x, y]);
           FCells.Add(no);
        end;
     end;

     if assigned(FOnResize) then FOnResize(self);
end;

// TWABD_EditTable
constructor TWABD_EditTable.Create(AOwner: TComponent);
begin
     inherited;
     FEditSize:=7;
     FCols      := 5;
     FRows      := 5;
     Resize;
end;

destructor TWABD_EditTable.Destroy;
begin
     inherited;
end;

function TWABD_EditTable.GetCols:integer;
begin
     Result:=FCols;
end;

function TWABD_EditTable.GetRows:integer;
begin
     Result:=FRows;
end;

procedure TWABD_EditTable.SetCols(NewCols: integer);
begin
     FCols := NewCols;
     Resize;
end;

procedure TWABD_EditTable.SetRows(NewRows: integer);
begin
     FRows := NewRows;
     Resize;
end;

function TWABD_EditTable.CreateCell(Col,Row:integer):TWABD_SectionObject;
var
   ne:TWABD_Edit;
begin
     ne:=TWABD_Edit.Create(self);
     if ne<>nil then
     begin
          ne.Size:=FEditSize;
          ne.Width:=FEditSize*10;
          ne.Text:='';
     end;
     Result:=ne;
end;

function TWABD_EditTable.GetCell(Col, Row: integer): string;
var
   ne : TWABD_Edit;
begin
     ne := TWABD_Edit(GetCellObject(Col,Row));
     Result := ne.Text;
end;

procedure TWABD_EditTable.SetCell(Col, Row: integer; const Value: string);
var
   ne : TWABD_Edit;
begin
     ne := TWABD_Edit(GetCellObject(Col,Row));
     ne.Text := Value;
end;

// TWABD_DBEditTable_DataLink
procedure TWABD_DBEditTable_DataLink.ActiveChanged;
begin
     LayoutChanged;
     if assigned(FOnActiveChanged) then FOnActiveChanged(self);
end;

procedure TWABD_DBEditTable_DataLink.LayoutChanged;
var
   i:integer;
begin
     with DataSource.Dataset,FEditTable do
     begin
          if Active then
          begin
               FCols:=FieldCount;
               Resize;

               // Setup headerline.
               if FHeader then
               begin
                    for i:=0 to Cols-1 do
                        with TWABD_Label(FHeaders.Items[i]) do
                        begin
                             Caption:=Fields[i].DisplayLabel;
                        end;
               end;
          end;
     end;
     if assigned(FOnLayoutChanged) then FOnLayoutChanged(self);
end;

procedure TWABD_DBEditTable_DataLink.DatasetChanged;
begin
     if assigned(FOnDatasetChanged) then FOnDatasetChanged(self);
end;

// TWABD_DBEditTable
constructor TWABD_DBEditTable.Create(AOwner: TComponent);
begin
     inherited;
     FRowIDs:=TList.Create;
     FDataLink:=TWABD_DBEditTable_DataLink.Create;
     FDataLink.FEditTable:=self;
     FDataLink.DataSource:=nil;
     FDataLink.OnActiveChanged:=RecountRecords;
     FCols      := 5;
     FRows      := 5;
     FShowNavigator:=true;
     Resize;
end;

destructor TWABD_DBEditTable.Destroy;
begin
     FDataLink.free;
     FRowIDs.free;
     inherited;
end;

function TWABD_DBEditTable.CreateCell(Col,Row:integer):TWABD_SectionObject;
var
   ft:TFieldType;
   ni:TWABD_LiveImage;
   ne:TWABD_Edit;
   nl:TWABD_Label;
   nchb:TWABD_CheckBox;
   nmm:TWABD_Memo;
   fld:TField;
begin
     // Get corresponding field.
     if not IsLinked then
        fld:=nil
     else
         fld:=DataSource.Dataset.Fields[Col];

     // Create control of correct type according to field.
     if (fld=nil) or (fld.ReadOnly) then
     begin
          nl:=TWABD_Label.Create(self);
          if (nl<>nil) and (fld=nil) then nl.Caption:='<N/A>';
          Result:=nl;
          exit;
     end;

     // Determine field type.
     ft:=fld.DataType;
     if (ft=ftBlob) then
        with TBlobField(fld) do
        begin
             if (BlobType=ftGraphic) or (BlobType=ftTypedBinary) then ft:=ftGraphic
             else if (BlobType=ftMemo) or (BlobType=ftFmtMemo) then ft:=ftMemo;
        end;

     case ft of
          ftTypedBinary,
          ftGraphic:
            begin
                 ni:=TWABD_LiveImage.Create(nil);
                 if ni<>nil then
                 begin
                      ni.ImageWidth:=GridX-1;
                      ni.ImageHeight:=GridY-1;
                      ni.Width:=ni.ImageWidth;
                      ni.Height:=ni.ImageHeight;
                 end;
                 Result:=ni;
            end;

          ftMemo,ftFmtMemo:
            begin
                 nmm:=TWABD_Memo.Create(nil);
                 if nmm<>nil then
                 begin
                      nmm.Width:=GridX-1;
                      nmm.Height:=GridY-1;
                 end;
                 Result:=nmm;
            end;

{$ifndef LEVEL3}
          ftWideString,ftFixedChar,
{$endif}
          ftString:
            begin
                 ne:=TWABD_Edit.Create(nil);
                 if ne<>nil then
                 begin
                      ne.Text:='';
                      ne.Size:=fld.Size;
                      ne.MaxLength:=ne.Size;
                      ne.Width:=ne.Size*10;
                 end;
                 Result:=ne;
            end;

{$ifndef LEVEL3}
          ftLargeInt,
{$endif}
          ftSmallInt,ftInteger,ftWord:
            begin
                 ne:=TWABD_Edit.Create(nil);
                 if ne<>nil then
                 begin
                      ne.Text:='';
                      ne.Size:=6;
                      ne.Width:=ne.Size*10;
                 end;
                 Result:=ne;
            end;

          ftBoolean:
            begin
                 nchb:=TWABD_CheckBox.Create(nil);
                 if nchb<>nil then
                 begin
                      nchb.Caption:='';
                      nchb.Width:=20;
                 end;
                 Result:=nchb;
            end;
     else
          begin
               nl:=TWABD_Label.Create(nil);
               if nl<>nil then
               begin
                    nl.Caption:='';
                    nl.Width:=200;
               end;
               Result:=nl;
          end;
     end;
end;

procedure TWABD_DBEditTable.Notification(AComponent: TComponent; Operation: TOperation);
begin
     inherited;
     if (Operation = opRemove) and (AComponent = FDataLink.DataSource) then
        FDataLink.DataSource := nil;
end;

procedure TWABD_DBEditTable.SetShowNavigator(Shown:boolean);
begin
     FShowNavigator:=Shown;
     Resize;
end;

function TWABD_DBEditTable.GetDataSource: TDataSource;
begin
     Result := FDataLink.DataSource;
end;

procedure TWABD_DBEditTable.SetDataSource(NewDataSource: TDataSource);
begin
     FDataLink.DataSource := NewDataSource;
     if NewDataSource<>nil then NewDataSource.FreeNotification(self);
end;

function TWABD_DBEditTable.IsLinked:boolean;
begin
     Result:=(FDataLink<>nil) and (FDataLink.DataSource<>nil) and (FDataLink.DataSource.DataSet<>nil) and
         (FDataLink.DataSource.DataSet.Active);
end;

procedure TWABD_DBEditTable.RecountRecords(Sender:TObject);
begin
     if IsLinked then
        with FDataLink.DataSource.DataSet do
        begin
             if Active then FActiveRec:=1
             else FActiveRec:=0;
             if (Active) and (FCalcPages) then
             begin
                 Last;
                 First;
                 FRecordCount:=RecordCount;
             end;
        end;
end;

function TWABD_DBEditTable.Object_To_HTML:string;
begin
     Populate(0);
     Result:=inherited Object_To_HTML;
end;

procedure TWABD_DBEditTable.Populate(FromRecord:integer);
var
   x,y:integer;
   bm:TBookmark;
   no:TWABD_SectionObject;
   fld:TField;
   ft:TFieldType;
   bmp:TBitmap;
begin
     if not IsLinked then exit;

     // Setup cell info.
     with DataSource.DataSet do
     begin
          if Active then
          begin
             bm:=GetBookmark;
             try
                // Clear bookmarks.
                for y:=FRowIDs.count-1 downto 0 do
                begin
                     FreeBookmark(TBookmark(FRowIDs.Items[y]));
                     FRowIDs.Delete(y);
                end;

                // Fill in the values.
                for y:=0 to Rows-1 do
                begin
                     // Store bookmarks for easy reference to the record later on update.
                     FRowIDs.Add(GetBookMark);

                     // Copy record contents to the controls.
                     for x:=0 to Cols-1 do
                     begin
                          no:=TWABD_SectionObject(FCells.Items[x*Rows+y]);
                          fld:=FDataLink.DataSource.DataSet.Fields[x];

                          // Determine field type.
                          ft:=fld.DataType;
                          if (ft=ftBlob) then
                             with TBlobField(fld) do
                             begin
                                  if (BlobType=ftGraphic) or (BlobType=ftTypedBinary) then ft:=ftGraphic
                                  else if (BlobType=ftMemo) or (BlobType=ftFmtMemo) then ft:=ftMemo;
                             end;

                          case ft of
                               ftTypedBinary,
                               ftGraphic:
                                  with TWABD_LiveImage(no) do
                                  begin
                                       bmp:=TBitmap.create;
                                       try
                                          bmp.Assign(TBlobField(fld));
                                          Canvas.StretchDraw(Rect(0,0,Width,Height),bmp);
                                       finally
                                          bmp.free;
                                       end;
                                  end;

                               ftMemo,ftFmtMemo:
                                  with TWABD_Memo(no) do
                                  begin
                                       Lines.Text:=fld.AsString;
                                       WordWrap:=taOut;
                                  end;

                     {$ifndef LEVEL3}
                               ftWideString,ftFixedChar,
                     {$endif}
                               ftString:
                                  with TWABD_Edit(no) do
                                  begin
                                       Text:=fld.AsString;
                                  end;

                     {$ifndef LEVEL3}
                               ftLargeInt,
                     {$endif}
                               ftSmallInt,ftInteger,ftWord:
                                  with TWABD_Edit(no) do
                                  begin
                                       Text:=fld.AsString;
                                  end;

                               ftBoolean:
                                  with TWABD_CheckBox(no) do
                                  begin
                                       Checked:=TBooleanField(fld).Value;
                                  end;
                          else
                               with TWABD_Label(no) do
                               begin
                                    Caption:='Unsupported field';
                               end;
                          end;
                     end;
                     next;
                end;
             finally
                GotoBookmark(bm);
                FreeBookmark(bm);
             end;
          end;
     end;
end;

end.