mORMot Open Source

 CanSelect := False; 

TSQLHttpClient(Database).ServerTimeStampSynchronize;
  CanSelect := False;

  DB := TSQLHttpClient.Create('192.168.99.99', '80', TSQLModel.Create([]));//non-existant server
  DB.WinAPI.ConnectTimeout := 5000;
  DB.ServerTimeStampSynchronize;

type
  TBarCodeWidths = array[0..4] of shortint;

const
  bar0 : TBarCodeWidths = (10,10,30,30,10);
  bar1 : TBarCodeWidths = (30,10,10,10,30);
  bar2 : TBarCodeWidths = (10,30,10,10,30);
  bar3 : TBarCodeWidths = (30,30,10,10,10);
  bar4 : TBarCodeWidths = (10,10,30,10,30);
  bar5 : TBarCodeWidths = (30,10,30,10,10);
  bar6 : TBarCodeWidths = (10,30,30,10,10);
  bar7 : TBarCodeWidths = (10,10,10,30,30);
  bar8 : TBarCodeWidths = (30,10,10,30,10);
  bar9 : TBarCodeWidths = (10,30,10,30,10);

var
  digits: string;
  x, y, barHeight: integer;
  barA, barB : TBarCodeWidths;
  digit1, digit2 : char;

begin
  ...
              while length(digits)<6 do digits := '0'+digits;
              canvas.Brush.Style := bsSolid;
              canvas.Brush.Color := clBlack;
              barheight := 60;
              x := 0;
              y := 0;
              Canvas.FillRect(Rect(y,x,y+10,x+BarHeight));
              y := y+20 ;
              Canvas.FillRect(Rect(y,x,y+10,x+BarHeight));
              y := y+20 ;
              for ii := 0 to 2 do begin
                Digit1 := digits[(ii*2)+1];
                Digit2 := digits[(ii*2)+2];
                Case digit1 of
                  '0' : for z := 0 to 4 do bara[z] := bar0[z];
                  '1' : for z := 0 to 4 do bara[z] := bar1[z];
                  '2' : for z := 0 to 4 do bara[z] := bar2[z];
                  '3' : for z := 0 to 4 do bara[z] := bar3[z];
                  '4' : for z := 0 to 4 do bara[z] := bar4[z];
                  '5' : for z := 0 to 4 do bara[z] := bar5[z];
                  '6' : for z := 0 to 4 do bara[z] := bar6[z];
                  '7' : for z := 0 to 4 do bara[z] := bar7[z];
                  '8' : for z := 0 to 4 do bara[z] := bar8[z];
                  '9' : for z := 0 to 4 do bara[z] := bar9[z];
                end;
                Case digit2 of
                  '0' : for z := 0 to 4 do barb[z] := bar0[z];
                  '1' : for z := 0 to 4 do barb[z] := bar1[z];
                  '2' : for z := 0 to 4 do barb[z] := bar2[z];
                  '3' : for z := 0 to 4 do barb[z] := bar3[z];
                  '4' : for z := 0 to 4 do barb[z] := bar4[z];
                  '5' : for z := 0 to 4 do barb[z] := bar5[z];
                  '6' : for z := 0 to 4 do barb[z] := bar6[z];
                  '7' : for z := 0 to 4 do barb[z] := bar7[z];
                  '8' : for z := 0 to 4 do barb[z] := bar8[z];
                  '9' : for z := 0 to 4 do barb[z] := bar9[z];
                end;
                for z := 0 to 4 do begin
                  Canvas.FillRect(Rect(y,x,(y+bara[z]),x+BarHeight));
                  y := y+bara[z]+barb[z] ;
                end;
              end;
              canvas.FillRect(Rect(y,x,y+30,x+BarHeight));
              canvas.FillRect(Rect(y+40,x,y+50,x+BarHeight));

...

procedure TableToCSV(Table: TSQLTableJSON; CSV: TFileStream);
var
  i, row, col, FMax: integer;
  W: TTextWriter;
  s : string;
  E: PEnumType;
  EP: PShortString;
  P: TSQLPropInfo;
  Sets, SetMax: cardinal;
  SetItemName, RawSetItemName: RawUTF8;
begin
  if (Table.FieldCount<=0) or (Table.RowCount<=0) then
    exit;
  W := TTextWriter.Create(CSV,8196);
  FMax := Table.FieldCount -1;
  try
    W.AddShort(#$ef#$bb#$bf); // add UTF-8 Byte Order Mark
    for row := 0 to Table.RowCount -1 do
      for col := 0 to FMax do begin
        case Table.ExpandAsString(Row,Col,database,s) of
          sftBoolean: if s = '0' then
                        W.AddString('False')
                      else
                        W.AddString('True');
          sftTimeLog: if Table.GetU(row,col) <> '120795955200' then
                        W.AddString(QuotedStr(stringtoUTF8(s),'"'))
                      else
                        W.AddString('""');
          sftSet: begin
                    P := Table.QueryRecordType.RecordProps.Fields.List[col-1];
                    E := (P as TSQLPropInfoRTTISet).SetEnumType;
                    if E^.MaxValue>31 then // up to 32 elements in tkSet (GetOrdValue)
                      SetMax := 31
                    else
                      SetMax := E^.MaxValue;
                    Sets := GetInteger(pointer(s));
                    EP := @E^.NameList;
                    W.Add('"');
                    for i := 0 to SetMax do begin
                      if GetBit(Sets, i) then begin
                        setItemName := '';
                        RawSetItemName := ShortStringToAnsi7String(EP^);
                        SetLength(setItemName,PInteger(PtrInt(RawSetItemName)-sizeof(integer))^*2);
                        SetLength(setItemName,UnCamelCase(pointer(setItemName),TrimLeftLowerCase(RawSetItemName)));
                        W.AddString(setItemName);
                        W.Add(',');
                      end;
                      inc(PtrInt(EP),ord(EP^[0])+1); // next enumeration item
                    end;
                    W.CancelLastComma;
                    W.Add('"');
                  end;
          else
            W.AddString(QuotedStr(stringtoUTF8(s),'"'));
        end;
        if col=FMax then
          W.AddCR
        else
          W.Add(',');
      end;
    W.Flush;
  finally
    W.Free;
  end;
end;

var
  JSONBuffer: RawUTF8;

procedure example;
var
  Table: TSQLTable;
  Rows: ISQLDBRows;
begin
  Rows := Client.Execute('select * from SGRUSR01',[]);
  fJSONBuffer := Rows.FetchAllAsJSON(false);
  Table := TSQLTableJSON.Create([],'',pointer(fJSONBuffer),length(fJSONBuffer));
...