Chip 1998 March/Chip_1998-03_cd.bin/zkuste/delphi/ruzkomp/INMEMDEL.ZIP/main.pas

Pascal/Delphi Source File | 1996-10-01 | 12.3 KB | 357 lines

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ExtCtrls, DBGrids, DB, DBTables, BDE, Win32Except, About;

type
  TMainForm = class(TForm)
    SourcePanel: TPanel;
    InMemPanel: TPanel;
    CopyTable: TButton;
    InMemGrid: TStringGrid;
    DemoTable: TTable;
    DemoSource: TDataSource;
    SourceGrid: TDBGrid;
    DataLbl: TLabel;
    LocalDatabase: TDatabase;
    procedure CopyTableClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    hInMemCur: hDBICur;
    function FieldAsString(hCur: hDBICur; pRecBuf: pBYTE; FieldNo: word;
                  FieldType: word): string;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormShow(Sender: TObject);
var
  A: TAboutBox;

begin
  DemoTable.Open;
  A := TAboutBox.Create(nil);
  try
    A.ShowModal;
  finally
    A.Free;
  end;
end;

procedure TMainForm.CopyTableClick(Sender: TObject);
var
  Fld: word;                              // For loop counter...
  pfDesc: pFLDDesc;                       // Field Descriptor for In-Memory table...
  hTmpCur, hInMemCur: hDBICur;            // Table cursors...
  pFldBuf, pInMemRecBuf, pRecBuf: pBYTE;  // Buffers...
  rslt: DBIResult;                        // Dbi Function results...
  fldType: array[1..1024] of word;        // Field types...
  Cols: array[1..1024] of word;           // Column sizes...
  CurrentRow: longint;                    // Current row on string grid...
  Props: CURProps;                        // In-Memory table properties...
  Blank: BOOL;                            // Blank field?? ...
  Len: TSize;                             // Length of string in string grid...

begin
  screen.cursor := crHourGlass;
  try
    // Initialize pointers to nil...
    pfDesc := nil; hTmpCur := nil; hInMemCur := nil; pFldBuf := nil;
    pInMemRecBuf := nil; pRecBuf := nil;
    // Initialize column widths to default...
    for Fld := 1 to 1024 do
      Cols[Fld] := InMemGrid.DefaultColWidth;
    // Clone the cursor so that moving the cursor will not effect DBGrid...
    Check(DbiCloneCursor(DemoTable.Handle, True, False, hTmpCur));
    // Allocate memory for field descriptor...
    pfDesc := AllocMem(DemoTable.FieldCount * sizeof(FLDDesc));
    // Populate the field descriptor with the DemoTable information...
    Check(DbiGetFieldDescs(hTmpCur, pfDesc));
    // Create the In-Memory table with the same fields as the DemoTable...
      Check(DbiCreateInMemTable(LocalDataBase.Handle, 'InMem_Table',
                    DemoTable.FieldCount, pfDesc, hInMemCur));
    // Get the table properties of the newly created In-Memory table...
    Check(DbiGetCursorProps(hInMemCur, Props));
    // The record buffer for the In-Memory table is slightly different than the
    //  source table, so we need to re-evalluate the buffer size...
    pInMemRecBuf := AllocMem(Props.iRecBufSize);
    // Set the grid row and columns to the size of DemoTable...
    InMemGrid.RowCount := DemoTable.RecordCount + 1;
    InMemGrid.ColCount := DemoTable.FieldCount + 1;
    // It is easier to use Dbi functions to retrieve information from the source
    // table, because we need to use Dbi functions to put information into the
    // In-Memory table...
    pRecBuf := AllocMem(DemoTable.RecordSize);
    // Generic Field buffer used for moveing field data from source to In-Mem...
    pFldBuf := AllocMem(1024);
    // Place the names of the fields in the string grid...
    for Fld := 0 to DemoTable.FieldCount - 1 do
    begin
      InMemGrid.Cells[Fld + 1, 0] := pfDesc^.szName;
      fldType[Fld + 1] := pfDesc^.iFldType;
      Inc(pfDesc);
    end;
    Dec(pfDesc, DemoTable.FieldCount);

    // Set the cursor to the source table to the top...
    Check(DbiSetToBegin(hTmpCur));
    rslt := DBIERR_NONE;

    while rslt = DBIERR_NONE do
    begin
      // Clear the record buffer (always on an insert / append)...
      Check(DbiInitRecord(hInMemCur, pinMemRecBuf));
      // Fill the source record buffer with table information...
      rslt :=  DbiGetNextRecord(hTmpCur, dbiNOLOCK, pRecBuf, nil);
      if rslt <> DBIERR_EOF then
      begin
        // for every field in the record buffer...
        for Fld := 1 to DemoTable.FieldCount do
        begin
          FillChar(pFldBuf^, 1024, #0);
          // Extract the field from the source record buffer...
          Check(DbiGetField(hTmpCur, Fld, pRecBuf, pFldBuf, Blank));
          if Blank = true then
            // If the source field is blank, put a nil in the destination record buffer...
            Check(DbiPutField(hInMemCur, Fld, pInMemRecBuf, nil))
          else
            // Place the source field information into the record buffer...
            Check(DbiPutField(hInMemCur, Fld, pInMemRecBuf, pFldBuf));
        end;
        // Once the record buffer is filled, add the record to the In-Memory table...
        Check(DbiAppendRecord(hInMemCur, pInMemRecBuf));
      end;
    end;

    // Set the In-Memory table cursor to the top of the table...
    Check(DbiSetToBegin(hInMemCur));
    CurrentRow := 1;
    rslt := DBIERR_NONE;
    // Go through the entire table retreiving record information...
    while rslt = DBIERR_NONE do
    begin
      // Place the next record into the record buffer...
      rslt :=  DbiGetNextRecord(hInMemCur, dbiNOLOCK, pInMemRecBuf, nil);
      // If we have not reached the end of the table...
      if rslt <> DBIERR_EOF then
      begin
        // Set the current row number in the string grid...
        InMemGrid.Cells[0, CurrentRow] := IntToStr(CurrentRow);
        // Go through each field in the record buffer...
        for Fld := 1 to DemoTable.FieldCount do
        begin
          // Call a function to send a translated string back and place the
          // information in the specified cell...
          InMemGrid.Cells[Fld, CurrentRow] :=
                   FieldAsString(hinMemCur, pInMemRecBuf, Fld, fldType[Fld]);
          // Determine the size of the returned string so we can extend the size
          // of the current column to accomodate the string length...
          Win32Chk(GetTextExtentPoint32(InMemGrid.Canvas.Handle, Pchar(InMemGrid.Cells[Fld, CurrentRow]),
                    Length(InMemGrid.Cells[Fld, CurrentRow]), Len));
          if Len.cx > Cols[Fld] then
            Cols[Fld] := Len.cx;
        end;
        Inc(CurrentRow);
      end;
    end;
    // Check the field names to make sure that they will fit into the string grid...
    for Fld := 0 to DemoTable.FieldCount do
    begin
      Win32Chk(GetTextExtentPoint32(InMemGrid.Canvas.Handle, Pchar(InMemGrid.Cells[Fld, 0]),
                Length(InMemGrid.Cells[Fld, 0]), Len));
      if Len.cx > Cols[Fld] then
        Cols[Fld] := Len.cx;
    end;

    // Set the string grid column widths...
    for Fld := 1 to DemoTable.FieldCount do
      InMemGrid.ColWidths[Fld] := Cols[Fld] + 8;

  finally
    // Close the source table cursor...
    if hTmpCur <> nil then
      Check(DbiCloseCursor(hTmpCur));
    // Close the In-Memory table cursor...
    if hInMemCur <> nil then
      Check(DbiCloseCursor(hInMemCur));
    // Free memory for field, table descriptor, and record buffers...
    if pfDesc <> nil then
      FreeMem(pfDesc);
    if pRecBuf <> nil then
      FreeMem(pRecBuf);
    if pInMemRecBuf <> nil then
      FreeMem(pInMemRecBuf);
    if pFldBuf <> nil then
      FreeMem(pFldBuf);
    screen.cursor := crDefault;
  end;
end;


// This function returns logical data types that are supported by in-Memory tables
//  in string form.  This is a good generic Dbi Field -> string function.

// NOTE: Checking the Blank parameter from DbiGetField to determine if a field
// is actually blank, is not supported on In-Memory tables.  Results from
// certain field types may need to be changed to fit your needs!
function TMainForm.FieldAsString(hCur: hDBICur; pRecBuf: pBYTE; FieldNo: word;
                  FieldType: word): string;
var
  S, AMPM, tmpString, TimeStr, TimeStampStr: string;
  tmpInt16: smallint;
  tmpInt32: longint;
  tmpFloat: double;
  tmpTime: BDE.time;
  tmpDate: BDE.DbiDate;
  tmpTimestamp: BDE.TimeStamp;
  Blank: BOOL;
  tmpPChar: pChar;
  Hour, Minute, MSecond, Month, Day: word;
  Year: SmallInt;

begin
  Result := '';
  TimeStr := '%d:%d:%d %s';
  TimeStampStr := '%d/%d/%d @ %d:%d:%d %s';

  case FieldType of
    // For character type fields...
    fldZSTRING:
    begin
      tmpPChar := AllocMem(1024);
      Check(DbiGetField(hCur, FieldNo, pRecBuf, tmpPChar, Blank));
      tmpString := tmpPChar;
      freemem(tmpPChar);
      // This is where a blank field is determined...
      if tmpString = '' then
        result := '(Blank)'
      else
        result := tmpString;
    end;
    // For INT16 (SmallInt) type fields...
    fldINT16:
    begin
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpInt16), Blank));
      result := IntToStr(tmpInt16);
    end;
    // For INT32 (LongInt, Integer) type fields...
    fldINT32:
    begin
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpInt32), Blank));
      result := IntToStr(tmpInt32);
    end;
    // For FLOAT (Numeric, Decimal) type fields...
    fldFLOAT:
    begin
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpFloat), Blank));
      result := FloatToStr(tmpFloat);
    end;
    // For TIME type fields...
    fldTIME:
    begin
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpTime), Blank));
      // This is where a blank field is determined...
      if tmpTime = 0 then
        result := '(Blank)'
      else
      begin
        Check(DbiTimeDecode(tmpTime, Hour, Minute, MSecond));
        case Hour of
          0:
          begin
            Hour := 12;
            AMPM := 'AM';
          end;
          1..11:
            AMPM := 'AM';
          12:
            AMPM := 'PM';
          13..24:
          begin
            AMPM := 'PM';
            Dec(Hour, 12);
          end;
        end;
        if (Minute < 10) and ((MSecond div 1000) < 10) then
          TimeStr := '%d:0%d:0%d %s'
        else
          if (Minute < 10) and ((MSecond div 1000) >= 10) then
            TimeStr := '%d:0%d:%d %s'
          else
            if (Minute > 10) and ((MSecond div 1000) < 10) then
              TimeStr := '%d:%d:0%d %s';
        result := Format(TimeStr, [Hour, Minute, MSecond div 1000, AMPM]);
      end;
    end;
    // For DATE type fields...
    fldDATE:
    begin
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpDate), Blank));
      // This is where a blank field is determined...
      if tmpDate = 0 then
        result := '(Blank)'
      else
      begin
        Check(DbiDateDecode(tmpDate, Month, Day, Year));
        result := Format('%d/%d/%d', [Month, Day, Year]);
      end;
    end;
    // For TIMESTAMP (Date: InterBase) type fields...
    fldTIMESTAMP:
    begin
      // This is where a blank field is determined...
      Check(DbiGetField(hCur, FieldNo, pRecBuf, pBYTE(@tmpTimeStamp), Blank));
      if tmpTimeStamp = 0 then
        result := '(Blank)'
      else
      begin
        Check(DbiTimeStampDecode(tmpTimeStamp, tmpDate, tmpTime));
        Check(DbiTimeDecode(tmpTime, Hour, Minute, MSecond));
        Check(DbiDateDecode(tmpDate, Month, Day, Year));
        case Hour of
          0:
          begin
            Hour := 12;
            AMPM := 'AM';
          end;
          1..11:
            AMPM := 'AM';
          12:
            AMPM := 'PM';
          13..24:
          begin
            AMPM := 'PM';
            Dec(Hour, 12);
          end;
        end;
        if (Minute < 10) and ((MSecond div 1000) < 10) then
          TimeStampStr := '%d/%d/%d @ %d:0%d:0%d %s'
        else
          if (Minute < 10) and ((MSecond div 1000) >= 10) then
            TimeStampStr := '%d/%d/%d @ %d:0%d:%d %s'
          else
            if (Minute > 10) and ((MSecond div 1000) < 10) then
              TimeStampStr := '%d/%d/%d @ %d:%d:0%d %s';

        result := Format(TimeStampStr, [Month, Day, Year, Hour,
                                  Minute, MSecond div 1000, AMPM]);
      end;
    end;
  else
    result := 'Unknown';
  end;
end;

end.