fqbclass.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  SQL.Free
end;

procedure fqbSaveToStr(TableArea: TfqbTableArea; Grid: TfqbGrid; var Str: TStringList);
  var
    i: integer;
    tmp, tmp2: string;
begin
  Str.Clear;
  tmp2 := fqbGenerateSQL(TableArea, Grid);
  tmp := fqbTrim(tmp2, [#10,#13]);

  Str.Add('[DataBase]');
//  Str.Add('DB=' + fqbActiveEngine.ConnectionString);
  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:= 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 fqbUseCoding 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 fqbSaveToFile(TableArea: TfqbTableArea; Grid: TfqbGrid; const FileName: string);
  var
    tmp: TStringList;
begin
  tmp := TStringList.Create;
  fqbSaveToStr(TableArea, Grid, tmp);
  tmp.SaveToFile(FileName);
  tmp.Free;
end;

procedure fqbRecognizeModel(TableArea: TfqbTableArea; Grid: TfqbGrid; 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.');
    Exit
  end;
  try
{    fqbActiveEngine.CloseResultQuery;
    fqbActiveEngine.Disconnect;
    fqbActiveEngine.ConnectionString := fqbFile.ReadString('DataBase','DB','');
    if fqbActiveEngine.ConnectionString = '' then Exit;
    fqbActiveEngine.Connect;}
    fqbActiveEngine.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
      fqbClear(GetParentForm(TableArea));
      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,1),fqbParse(',',parstr,2));
        if vis = nil then Exit;

        vis.ChBox.Checked[IndexOf(tbl.Names[i])]:= true;
        vis.ChBox.ItemIndex:= IndexOf(tbl.Names[i]);
        vis.ChBox.ClickCheck;

//        n:= Grid.Items.Count - 1;

        TGridColumn(Grid.Items[i].Data^).Table:= fqbParse(',',parstr,1);
        TGridColumn(Grid.Items[i].Data^).Alias:= fqbParse(',',parstr,2);
        TGridColumn(Grid.Items[i].Data^).Field:= tbl.Names[i];
        TGridColumn(Grid.Items[i].Data^).Visibl:= Boolean(StrToInt(fqbParse(',',parstr,3)));
        TGridColumn(Grid.Items[i].Data^).Sort:= StrToInt(fqbParse(',',parstr,4));
        TGridColumn(Grid.Items[i].Data^).Func:= StrToInt(fqbParse(',',parstr,5));
        TGridColumn(Grid.Items[i].Data^).Group:= StrToInt(fqbParse(',',parstr,6));
        TGridColumn(Grid.Items[i].Data^).Where:= fqbParse(',',parstr,7);

    //  format:
    //      field_name = table_name, alias, visible, sorting, function, group, where
        end;
      except
        fqbClear(GetParentForm(TableArea));
        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
    //  format:
    //      index = sind,slst,dind,dlst,JType,JOper
        end;
      except
        fqbClear(GetParentForm(TableArea));
        Exit
      end;
      Grid.UpdateColumn;
    finally
      fqbFile.Free;
      tbl.Free
    end
end;

procedure fqbLoadFromStr(TableArea: TfqbTableArea; Grid: TfqbGrid; const Str: TStringList);
  var
    tmp : string;
begin
  tmp := fqbGetUniqueFileName('fqb');
  Str.SaveToFile(tmp);
  try
    fqbLoadFromFile(TableArea, Grid, tmp);
  finally
    DeleteFile(tmp)
  end
end;

procedure fqbLoadFromFile(TableArea: TfqbTableArea; Grid: TfqbGrid; 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 fqbUseCoding then
    begin
      tmp := fqbTrim(tmp, [#10,#13]);
      tmp:= fqbDeCompress(tmp)
    end;

    StrLst.Clear;
    StrLst.Text := tmp;

    tmp := fqbGetUniqueFileName('fqb');
    StrLst.SaveToFile(tmp);
    tmp2 := fqbTrim(tmp2, [#10,#13]);
    fqbRecognizeModel(TableArea, Grid, fqbStringCRC32(tmp2), tmp);
  finally
    DeleteFile(tmp);

    StrLst.Free;
    StrSrc.Free;
  end; 
end;

procedure fqbClear(const AForm: TCustomForm);
  var
    tmp: TComponent;
    i: Integer;
begin
  tmp := FindFQBcomp('TfqbGrid', AForm);
  if Assigned(tmp) then
  begin
    for i:= TfqbGrid(tmp).Items.Count - 1 downto 0 do
      Dispose(PGridColumn(TfqbGrid(tmp).Items[i].Data));
    TfqbGrid(tmp).Items.Clear
  end;

  tmp := FindFQBcomp('TfqbTableArea', AForm);
  if Assigned(tmp) then
    for i := tmp.ComponentCount - 1 downto 0 do
      TfqbTable(tmp.Components[i]).Free
end;

function ExtractSchema(const Value: string): string;
var
  e, b: Integer;
begin
  b := Pos(_fqbBeginModel, Value) + Length(_fqbBeginModel);
  e := Pos(_fqbEndModel, Value);
  if not (e = 0) then
  begin
    Result := Copy(Value, b, e-b);
    Result := fqbTrim(Result, [#10, #13]);
  end
  else
    Result := Value;
end;

function ExtractSQL(const Str: string): string;
var
  e, b: Integer;
begin
  b := Pos(_fqbBeginModel, Str);
  e := Pos(_fqbEndModel, Str);
  Result := Str;
  Delete(Result, b, e);
end;

{-----------------------  TfqbField -----------------------}
function TfqbField.GetFieldName: string;
begin
  if ((Pos(' ', FFieldName) > 0) or (Pos('/', FFieldName) > 0)) then
    Result := '"' + FFieldName + '"'
  else
    Result := FFieldName
end;

{-----------------------  TfqbFieldList -----------------------}
function TfqbFieldList.Add: TfqbField;
begin
  Result := TfqbField(inherited Add)
end;

function TfqbFieldList.GetItem(Index: Integer): TfqbField;
begin
  Result := TfqbField(inherited Items[Index])
end;

procedure TfqbFieldList.SetItem(Index: Integer; const Value: TfqbField);
begin
  Items[Index].Assign(Value)
end;

{-----------------------  TfqbLinkList -----------------------}
function TfqbLinkList.Add: TfqbLink;
begin
  Result := TfqbLink(inherited Add)
end;

function TfqbLinkList.GetItem(Index: Integer): TfqbLink;
begin
  Result := TfqbLink(inherited Items[Index])
end;

procedure TfqbLinkList.SetItem(Index: Integer; const Value: TfqbLink);
begin
  Items[Index].Assign(Value)
end;

{-----------------------  TfqbLink -----------------------}
constructor TfqbLink.Create(Collection: TCollection);
var
  tmp: TMenuItem;
begin
  inherited Create(Collection);
  FJOp := 0;
  FJType:= 0;
  FMenu:= TPopupMenu.Create(nil);
  tmp:= TMenuItem.Create(FMenu);
  tmp.Caption:= 'Link options';
  tmp.OnClick:= DoOptions;
  FMenu.Items.Add(tmp);
  tmp:= TMenuItem.Create(FMenu);
  tmp.Caption:= 'Delete';
  tmp.OnClick:= DoDelete;
  FMenu.Items.Add(tmp)
end;

destructor TfqbLink.Destroy;
begin
  SourceField.Linked := false;
  DestField.Linked := false;
  FMenu.Free;
  inherited Destroy;
end;

procedure TfqbLink.DoDelete(Sender: TObject);
begin
  Free
end;

procedure TfqbLink.DoOptions(Sender: TObject);
var
  fqbLinkForm: TfqbLinkForm;
begin
  fqbLinkForm := TfqbLinkForm.Create(nil);
  try
    fqbLinkForm.txtTable1.Caption := SourceTable.TableName;
    fqbLinkForm.txtCol1.Caption := SourceField.FieldName;
    fqbLinkForm.txtTable2.Caption := DestTable.TableName;
    fqbLinkForm.txtCol2.Caption := DestField.FieldName;;
    fqbLinkForm.RadioOpt.ItemIndex := JoinOperator;
    fqbLinkForm.RadioType.ItemIndex := JoinType;
    if fqbLinkForm.ShowModal = mrOk then
    begin
      JoinOperator := fqbLinkForm.RadioOpt.ItemIndex;
      JoinType := fqbLinkForm.RadioType.ItemIndex
    end;
  finally
    fqbLinkForm.Free
  end
end;

procedure TfqbLink.Draw;
var
  pnt1, pnt2: TPoint;
  cnt1, cnt2: Integer;
  dSrc, dDest: Integer;
  
  const Delta = 15;
  
begin
  pnt1:= SourceCoords;
  pnt2:= DestCoords;
  cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2);
        cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2);
  if cnt1 < cnt2 then
  begin
    dSrc:= Delta;
    dDest:= -Delta
  end
  else
  begin
    dSrc:= -Delta;
    dDest:= Delta
  end;
  FArea.FCanvas.MoveTo(pnt1.x, pnt1.y);
  FArea.FCanvas.Pen.Color:= clNotSelectedLink;
  FArea.FCanvas.Pen.Width:= 3;
  FArea.FCanvas.LineTo(pnt1.x + dSrc, pnt1.y);
  FArea.FCanvas.Pen.Width:= 1;
  if Selected then
    FArea.FCanvas.Pen.Color:= clSelectedLink
  else
    FArea.FCanvas.Pen.Color:= clNotSelectedLink;
  FArea.FCanvas.LineTo(pnt2.x + dDest, pnt2.y);
  FArea.FCanvas.Pen.Width:= 3;
  FArea.FCanvas.Pen.Color:= clNotSelectedLink;
  FArea.FCanvas.LineTo(pnt2.x, pnt2.y)
end;

function TfqbLink.GetDestCoords: TPoint;
var
  cnt1, cnt2: Integer;
begin
  cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2);
  cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2);
  
  if cnt1 < cnt2 then
    Result:= DestTable.GetLinkPoint(DestField.Index,'L')
  else
    Result:= DestTable.GetLinkPoint(DestField.Index,'R')
end;

function TfqbLink.GetSourceCoords: TPoint;
var
  cnt1, cnt2: Integer;
begin
  cnt1:= SourceTable.BoundsRect.Left + (SourceTable.Width div 2);
  cnt2:= DestTable.BoundsRect.Left + (DestTable.Width div 2);
  
  if cnt1 < cnt2 then
    Result:= SourceTable.GetLinkPoint(SourceField.Index,'R')
  else
    Result:= SourceTable.GetLinkPoint(SourceField.Index,'L')
end;

procedure TfqbLink.SetSelected(const Value: Boolean);
var
  i: Integer;
begin
  for i:= 0 to Collection.Count - 1 do
    TfqbLinkList(Collection).Items[i].FSelected := false;
  FSelected := Value
end;

{-----------------------  TfqbTableArea -----------------------}
constructor TfqbTableArea.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  Color := clBtnFace;
  FCanvas.Brush.Color := clBtnFace;
  
  FLinkList := TfqbLinkList.Create(Self, TfqbLink);
  
  FInstX := 15;
  FInstY := 15
end;

destructor TfqbTableArea.Destroy;
begin
  FCanvas.Free;
  FLinkList.Free;
  inherited Destroy;
end;

procedure TfqbTableArea.Click;
var
  n: Integer;
begin
  n := GetLineAtCursor;
  if ((n >= 0) and (n < LinkList.Count)) then
  begin
    LinkList[n].Selected := true;
    Invalidate;
    LinkList[n].FMenu.Popup(Mouse.CursorPos.X,Mouse.CursorPos.Y)
  end;
  inherited Click;
end;

function TfqbTableArea.CompareFields(TableID1: integer; FIndex1: integer; TableID2:
               integer; FIndex2: integer): Boolean;
begin
  if ((TableID1 > ComponentCount) or (TableID2 > ComponentCount)) then
    Result := false
  else
    Result := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType =
              TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType
end;

procedure TfqbTableArea.DragDrop(Source: TObject; X, Y: Integer);
begin
  InsertTable(X, Y, (Source as TfqbTableListBox).Items[(Source as TfqbTableListBox).ItemIndex])
end;

procedure TfqbTableArea.DragOver(Source: TObject; X, Y: Integer; State: TDragState;
               var Accept: Boolean);
begin
  Accept := Source is TfqbTableListBox
end;

function TfqbTableArea.FindTable(const AName, AAlias: string): TfqbTable;
var
  i: Integer;
begin
  Result:= nil;
  for i:= 0 to ComponentCount - 1 do
    if ((TfqbTable(Components[i]).TableName = AName) and
        (TfqbTable(Components[i]).AliasName = AAlias)) then
      Result:= TfqbTable(Components[i])
end;

function TfqbTableArea.GenerateAlias(const ATableNAme: string): string;
var
  n: Integer;