fqbclass.pas

这个是功能强大的报表软件

      begin
        Tbl1 := TableArea.LinkList[Integer(CopyLL[i])].SourceTable;
        Tbl2 := Tbl3;
        slFrom.Add(strTab + FormingFrom(Integer(CopyLL[i])));
        CopyLL[i] := Pointer(-1)
       end
  
    end;
    CopyLL.Delete(0);
    for i := CopyLL.Count - 1 downto 0 do
      if Integer(CopyLL[i]) = -1 then CopyLL.Delete(i)
  end;
  
  flg := false;
  for i := 0 to Grid.Items.Count - 1 do
  begin
    tmpStr := TGridColumn(Grid.Items[i].Data^).Table + ' '
                     + TGridColumn(Grid.Items[i].Data^).Alias;
  
    if Pos(tmpStr, slFrom.Text) = 0 then
    begin
      if slFrom.Count <> 0 then
        slFrom[slFrom.Count - 1] := slFrom[slFrom.Count - 1] + ', ';
  
      slFrom.Add(strTab + tmpStr);
      flg := true
    end
  end;
  
  if flg then
    slFrom.Text := Copy(slFrom.Text,1,Length(slFrom.Text) - 2);
  
  CopyLL.Free;
  
  //WHERE
  slWhere := TStringList.Create;
  for i := 0 to Grid.Items.Count - 1 do
    if TGridColumn(Grid.Items[i].Data^).Where <> '' then
       slWhere.Add(strTab + TGridColumn(Grid.Items[i].Data^).Alias + '.'
                   + TGridColumn(Grid.Items[i].Data^).Field + ' ' 
                   + TGridColumn(Grid.Items[i].Data^).Where + ' AND');
  
  if slWhere.Count <> 0 then
  begin
    slWhere.Text:= Copy(slWhere.Text,1,Length(slWhere.Text) - 6);
    slWhere.Insert(0,strWhere)
  end;
  
  //ORDER
  orderStr:= '';
  prd:= '';
  flg:= false;
  for i:= 0 to Grid.Items.Count - 1 do
  begin
    if TGridColumn(Grid.Items[i].Data^).Sort <> 0 then
    begin
      if TGridColumn(Grid.Items[i].Data^).Sort = 2 then
              prd := 'DESC'
      else
              prd := '';
      orderStr:= orderStr + TGridColumn(Grid.Items[i].Data^).Alias + '.' +
                               TGridColumn(Grid.Items[i].Data^).Field + ' ' + prd + ', ';
      flg:= true;
    end;
  end;
  if flg then
    orderStr := Trim(Copy(orderStr,1,Length(orderStr) - 2));
  
  //GROUP
  groupStr:= '';
  flg:= false;
  for i:= 0 to Grid.Items.Count - 1 do
  begin
    if TGridColumn(Grid.Items[i].Data^).Group <> 0 then
    begin
      groupStr:= groupStr + TGridColumn(Grid.Items[i].Data^).Alias + '.' +
                            TGridColumn(Grid.Items[i].Data^).Field + ', ';
      flg:= true;
    end;
  end;
  if flg then groupStr:= Copy(groupStr,1,Length(groupStr) - 2);
  
  SQL.Add(strFrom);
  SQL.AddStrings(slFrom);
  SQL.AddStrings(slWhere);
  
  if orderStr <> '' then SQL.Add(strOrder + orderStr);
  
  if groupStr <> '' then SQL.Add(strGroup + groupStr);
  
  slFrom.Free;
  slWhere.Free;

  FText := SQL.Text;
  Result := SQL.Text;
  SQL.Free
end;

function TfqbCore.GetEngine: TfqbEngine;
begin
  Result := FEngine;
  if not Assigned(FEngine) then
    raise EfqbError.Create('fqbCore.Engine not assigned');
  
end;

function TfqbCore.GetGrid: TfqbGrid;
begin
  Result := FGrid;
  if not Assigned(FGrid) then
    raise EfqbError.Create('fqbCore.Grid not assigned');
end;

function TfqbCore.GetSQL: string;
begin
  if SchemaInsideSQL then
    Result := Ftext
  else
  Result := fqbCore.ExtractSQL(Ftext);
end;

function TfqbCore.GetSQLSchema: string;
begin
  if SchemaInsideSQL then
    Result := ''
  else
    Result := fqbCore.ExtractSchema(Ftext);
end;

function TfqbCore.GetTableArea: TfqbTableArea;
begin
  Result := FTableArea;
  if not Assigned(FTableArea) then
    raise EfqbError.Create('fqbCore.TableArea not assigned');
end;

procedure TfqbCore.LoadFromFile(const FileName: string);
var
  StrLst, StrSrc: TStringList;
  tmp, tmp2: string;
begin
  StrLst := TStringList.Create;
  StrSrc := TStringList.Create;
  StrSrc.LoadFromFile(FileName);
  
  try
    tmp2 := ExtractSQL(StrSrc.Text);
    tmp := ExtractSchema(StrSrc.Text);
  
    if fqbCore.FUseCoding then
    begin
      tmp := fqbTrim(tmp, [#10,#13]);
      if tmp = '' then Exit;
      tmp:= fqbDeCompress(tmp)
    end;
  
    StrLst.Clear;
    StrLst.Text := tmp;
  
    tmp := fqbGetUniqueFileName('fqb');
    StrLst.SaveToFile(tmp);
    tmp2 := fqbTrim(tmp2, [#10,#13]);
    fqbCore.RecognizeModel(fqbStringCRC32(tmp2), tmp);
  finally
    DeleteFile(tmp);
  
    StrLst.Free;
    StrSrc.Free;
  end;
end;

procedure TfqbCore.LoadFromStr(const Str: TStringList);
var
  tmp: string;
begin
  tmp := fqbGetUniqueFileName('fqb');
  Str.SaveToFile(tmp);
  try
    fqbCore.LoadFromFile(tmp);
  finally
    DeleteFile(tmp)
  end
end;

procedure TfqbCore.RecognizeModel(const crc32: Cardinal; const FileName: string);
var
  fqbFile: TIniFile;
  tbl: TStringList;
  i: Integer;
  Rec: TRect;
  parstr, tmpstr: string;
  vis: TfqbTable;
  lnk: TfqbLink;
  c: Cardinal;
  
  function IndexOf(const FieldName: string): integer;
    var
      i: integer;
  begin
    Result:= -1;
    for i:= 0 to vis.FieldList.Count - 1 do
      if TfqbField(vis.FieldList[i]).FieldName = FieldName then
        Result:= i;
   end;
  
begin
  fqbFile:= TIniFile.Create(FileName);
  tbl:= TStringList.Create;
  tmpstr := fqbFile.ReadString('DataBase','SQL','');
  c := StrToInt64(tmpstr);
  if c <> crc32 then
  begin
    ShowMessage('The file was changed. The Model can not be loaded.');
    fqbFile.Free;
    tbl.Free;
    Exit
  end;
  try
    fqbCore.Engine.ReadTableList(TfqbTableListBox(FindFQBcomp('TfqbTableListBox',GetParentForm(TableArea))).Items);
    fqbFile.ReadSectionValues('Tables',tbl);
    try
      for i:= 0 to tbl.Count - 1 do
      begin
        parstr:= tbl.Values[tbl.Names[i]];
        tmpstr:= fqbParse(',',parstr,1);
        Rec.Top:= StrToInt(fqbParse(',',parstr,2));
        Rec.Left:= StrToInt(fqbParse(',',parstr,3));
        Rec.Right:= StrToInt(fqbParse(',',parstr,4));
        Rec.Bottom:= StrToInt(fqbParse(',',parstr,5));
        TableArea.InsertTable(Rec.Left, Rec.Top, tmpstr);
        TfqbTable(TableArea.Components[i]).Height:= Rec.Right;
        TfqbTable(TableArea.Components[i]).Width:= Rec.Bottom
      end
    except
      fqbCore.Clear;
      Exit
    end;
    tbl.Clear;
    fqbFile.ReadSectionValues('Grid',tbl);
    try
      for i:= 0 to tbl.Count - 1 do
      begin
        parstr:=tbl.Values[tbl.Names[i]];
        vis:= TableArea.FindTable(fqbParse(',',parstr,2),fqbParse(',',parstr,3));
        if vis = nil then Exit;
  
        vis.ChBox.Checked[IndexOf(fqbParse(',',parstr,1))]:= true;
        vis.ChBox.ItemIndex:= IndexOf(fqbParse(',',parstr,1));
        vis.ChBox.ClickCheck;
  
  //        n:= Grid.Items.Count - 1;
  
        TGridColumn(Grid.Items[i].Data^).Table:= fqbParse(',',parstr,2);
        TGridColumn(Grid.Items[i].Data^).Alias:= fqbParse(',',parstr,3);
        TGridColumn(Grid.Items[i].Data^).Field:= fqbParse(',',parstr,1);
        TGridColumn(Grid.Items[i].Data^).Visibl:= Boolean(StrToInt(fqbParse(',',parstr,4)));
        TGridColumn(Grid.Items[i].Data^).Sort:= StrToInt(fqbParse(',',parstr,5));
        TGridColumn(Grid.Items[i].Data^).Func:= StrToInt(fqbParse(',',parstr,6));
        TGridColumn(Grid.Items[i].Data^).Group:= StrToInt(fqbParse(',',parstr,7));
        TGridColumn(Grid.Items[i].Data^).Where:= fqbParse(',',parstr,8, True);

      //  format:
      //      field_name = table_name, alias, visible, sorting, function, group, where
        end;
      except
        fqbCore.Clear;
        Exit
      end;
      tbl.Clear;
      fqbFile.ReadSectionValues('Links',tbl);
      try
        for i:= 0 to tbl.Count - 1 do
        begin
          parstr:=tbl.Values[tbl.Names[i]];
  
          lnk:= TfqbLink(TableArea.LinkList.Add);
          lnk.FArea:= TableArea;
          lnk.FSourceTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,2))]);
          lnk.FSourceField := lnk.SourceTable.FieldList[StrToInt(fqbParse(',',parstr,1))];
          lnk.SourceField.Linked := True;

          lnk.FDestTable := TfqbTable(TableArea.Components[StrToInt(fqbParse(',',parstr,4))]);
          lnk.FDestField := lnk.DestTable.FieldList[StrToInt(fqbParse(',',parstr,3))];
          lnk.FDestField.Linked := True;

          lnk.FJType := StrToInt(fqbParse(',',parstr, 5));
          lnk.FJOp := StrToInt(fqbParse(',',parstr, 6));
      //  format:
      //      index = sind,slst,dind,dlst,JType,JOper
        end;
      except
        fqbCore.Clear;
        Exit
      end;
      Grid.UpdateColumn;
    finally
      fqbFile.Free;
      tbl.Free
    end
end;

procedure TfqbCore.SaveToFile(const FileName: string);
var
  tmp: TStringList;
begin
  tmp := TStringList.Create;
  fqbCore.SaveToStr(tmp);
  tmp.SaveToFile(FileName);
  tmp.Free;
end;

procedure TfqbCore.SaveToStr(var Str: TStringList);
var
  i: Integer;
  tmp, tmp2: string;
begin
  Str.Clear;
  tmp2 := fqbCore.GenerateSQL;
  tmp := fqbTrim(tmp2, [#10,#13]);
  
  if tmp = '' then Exit;
  
  Str.Add('[DataBase]');
  Str.Add('SQL=' + IntToStr(fqbStringCRC32(tmp)));

  Str.Add('[Tables]');
  for i:= 0 to TableArea.ComponentCount - 1 do
  begin
    tmp := TfqbTable(TableArea.Components[i]).AliasName + '=';
    tmp := tmp + TfqbTAble(TableArea.Components[i]).TableName;
    tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Top);
    tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Left);
    tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Height);
    tmp := tmp + ',' + IntToStr(TfqbTable(TableArea.Components[i]).Width);
    Str.Add(tmp);
  //  format:
  //      alias= tablename,top,left,height,width
  end;
  
  Str.Add('[Grid]');
  for i:= 0 to Grid.Items.Count - 1 do
  begin
    tmp := IntToStr(i) + '=';
    tmp:= tmp + TGridColumn(Grid.Items[i].Data^).Field;
    tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Table;
    tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Alias;
    tmp:= tmp + ',' + IntToStr(Integer(TGridColumn(Grid.Items[i].Data^).Visibl));
    tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Sort);
    tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Func);
    tmp:= tmp + ',' + IntToStr(TGridColumn(Grid.Items[i].Data^).Group);
    tmp:= tmp + ',' + TGridColumn(Grid.Items[i].Data^).Where;
    Str.Add(tmp);
  //  format:
  //      field_name = table_name, alias, visible, sorting, function, group, where
  end;
  
  Str.Add('[Links]');
  for i:= 0 to TableArea.LinkList.Count - 1 do
  begin
    tmp:= IntToStr(i) + '=';
    tmp:= tmp + IntToStr(TableArea.LinkList[i].SourceField.Index);
    tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].SourceTable.ComponentIndex);
    tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestField.Index);
    tmp:= tmp + ',' + IntToStr(TableArea.LinkList[i].DestTable.ComponentIndex);
    tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinType);
    tmp:= tmp + ',' + IntToStr(TfqbLink(TableArea.LinkList[i]).JoinOperator);
    Str.Add(tmp);
  //  format:
  //      index = sind,slst,dind,dlst,JType,JOper
  end;
  
  if fqbCore.FUseCoding then
    tmp := fqbCompress(str.Text)
  else
    tmp := str.Text;
  
  Str.Clear;
  Str.Add(tmp2);
  Str.Add(_fqbBeginModel);
  Str.Add(tmp);
  Str.Add(_fqbEndModel);
end;

procedure TfqbCore.SetSchemaInsideSQL(const Value: Boolean);
begin
  FSchemaInsideSQL := Value;
  if SchemaInsideSQL then
  begin
    FSQL := fqbCore.ExtractSQL(Ftext);
    FSQLSchema := fqbCore.ExtractSchema(Ftext);
  end
end;

procedure TfqbCore.SetSQL(Value: string);
begin
  FSQL := fqbCore.ExtractSQL(Value);
  FSQLSchema := fqbCore.ExtractSchema(Value);
  Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel
end;

procedure TfqbCore.SetSQLSchema(const Value: string);
begin
  FSQLSchema := fqbCore.ExtractSchema(Value);
  Ftext := FSQL + _fqbBeginModel + #$D#$A + FSQLSchema + #$D#$A + _fqbEndModel
end;

{-----------------------  TfqbCheckListBox -----------------------}
procedure TfqbCheckListBox.ClickCheck;
var
  tmp: TfqbGrid;
  tbl: TfqbTable;
  i: Integer;
begin
  tmp := fqbCore.Grid;
  tbl := (Parent as TfqbTable);
  
  if not Assigned(tmp) then
    raise EfqbError.Create('Class TfqbGrid not fount on form.');
  
  if State[ItemIndex] = cbChecked then
  begin
    i:= tmp.AddColumn;
    TGridColumn(tmp.Items[i].Data^).Table:= tbl.TableName;
    TGridColumn(tmp.Items[i].Data^).Field:= tbl.FieldList[ItemIndex].FieldName;
    TGridColumn(tmp.Items[i].Data^).Alias:= tbl.AliasName;
    TGridColumn(tmp.Items[i].Data^).Where:= '';
    TGridColumn(tmp.Items[i].Data^).Sort:= 0;
    TGridColumn(tmp.Items[i].Data^).Func:= 0;
    TGridColumn(tmp.Items[i].Data^).Group:= 0;
    TGridColumn(tmp.Items[i].Data^).Visibl:= True
  end
  else
  if State[ItemIndex] = cbUnchecked then
  begin
    for i:= tmp.Items.Count - 1 downto 0 do
    begin
      if ((TGridColumn(tmp.Items[i].Data^).Table = tbl.TableName)
          and (TGridColumn(tmp.Items[i].Data^).Field = tbl.FieldList[ItemIndex].FieldName)) then
      begin
        FreeMem(tmp.Items[i].Data, SizeOf(TGridColumn));
        tmp.Items.Delete(i)
      end
    end
  end;
  tmp.UpdateColumn;
  Repaint;
  inherited ClickCheck;
end;

procedure TfqbCheckListBox.DragDrop(Sender: TObject; X, Y: Integer);
var
  lnk: TfqbLink;
begin
  lnk := (Parent.Parent as TfqbTableArea).LinkList.Add;
  lnk.FArea := Parent.Parent as TfqbTableArea;
  lnk.FSourceField := ((Sender as TControl).Parent as TfqbTable).SellectedField;
  lnk.FSourceField.Linked := true;
  lnk.FSourceTable := (Sender as TControl).Parent as TfqbTable;
  
  lnk.FDestField := (Self.Parent as TfqbTable).SellectedField;
  lnk.FDestField.Linked := true;
  lnk.FDestTable := Self.Parent as TfqbTable;
  
  TfqbTableArea(Parent.Parent).Invalidate;
  TfqbTable((Sender as TControl).Parent).Invalidate;
  Invalidate
end;