fqbclass.pas

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

  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;
var
  tp1, tp2: Integer;
begin
  if ((TableID1 > ComponentCount) or (TableID2 > ComponentCount)) then
    Result := false
  else
  begin
    tp1 := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType;
    tp2 := TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType;

    if ((tp1 in CompatibleIntTypes)
        and (tp2 in CompatibleIntTypes)) then
      Result := True
    else
    if ((tp1 in CompatibleDateTimeTypes)
        and (tp2 in CompatibleDateTimeTypes)) then
      Result := True
    else
    if ((tp1 in CompatibleFloatTypes)
        and (tp2 in CompatibleFloatTypes)) then
      Result := True
    else
      Result := TfqbTable(Components[TableID1]).FieldList[Findex1].FieldType =
                TfqbTable(Components[TableID2]).FieldList[Findex2].FieldType
  end
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;
  
  function FindDublicat(AAlias: string): boolean;
    var i: integer;
  begin
    Result:= False;
    for i:= 0 to ComponentCount - 1 do
    begin
      if AAlias = TfqbTable(Components[i]).AliasName then
      begin
        Result:= True;
        Break
      end
    end
  end;
  
begin
  Result:= ATableName[1];
  n:=1;
  while FindDublicat(Result) do
  begin
    Result:= ATableName[1] + IntToStr(n);
    Inc(n)
  end
end;

function TfqbTableArea.GetLineAtCursor: Integer;
  
    procedure SwapInt(var X, Y: Integer);
      var
        T: Integer;
    begin
      T := X;
      X := Y;
      Y := T
    end;
  
    function InRange(const AValue, AMin, AMax: Integer): Boolean;
    begin
      Result := (AValue >= AMin) and (AValue <= AMax)
    end;

    const
      sf = 6; //Scale factor
  var
    i,TX1, TX2, TY1,TY2,X1,Y1,
    X2,Y2,Lx, Ly, C: integer;
    MousePos: TPoint;
    Delta: Real;
  
begin
  Result:= - 1;
  for i:= 0 to LinkList.Count - 1 do
  begin
    MousePos:= Mouse.CursorPos;
    MousePos:= ScreenToClient(MousePos);
    X1:= TfqbLink(LinkList[i]).GetSourceCoords.X;
    X2:= TfqbLink(LinkList[i]).GetDestCoords.X;
    Y1:= TfqbLink(LinkList[i]).GetSourceCoords.Y;
    Y2:= TfqbLink(LinkList[i]).GetDestCoords.Y;
    TX1:= X1;
    TX2:= X2;
    TY1:= Y1;
    TY2:= Y2;
    if TX1> TX2 then SwapInt(TX1, TX2);
    if TY1> TY2 then SwapInt(TY1, TY2);
    Lx:= X2-X1;
    Ly:= Y2-Y1;
    C:= -Ly*X1 + Lx*Y1;
    Delta:= Sqrt(Power((X1-X2), 2) + Power((Y1-Y2), 2)) * sf;
    if (Abs(-Ly*MousePos.X + Lx*MousePos.Y - C)<= Delta) and
       InRange(MousePos.X, TX1 - sf, TX2 + sf) and
       InRange(MousePos.Y, TY1 - sf, TY2 + sf) then
    begin
      Result:= i;
      break
    end
  end
end;

procedure TfqbTableArea.InsertTable(const X, Y : integer; const Name: string);
var
  tmp: TfqbTable;
begin
  tmp := TfqbTable.Create(Self);
  tmp.Left := X;
  tmp.Top := Y;
  tmp.Parent := Self;
  tmp.TableName := Name;
  fqbCore.Engine.ReadFieldList(Name, tmp.FFieldList);
  tmp.UpdateFieldList
end;

procedure TfqbTableArea.InsertTable(const Name : string);
begin
  InsertTable(FInstX, FInstY, Name);
  
  if FInstY > Height then
    FInstY:= 15
  else
    FInstY:= FInstY + 15;
  
  if FInstX > Width then
    FInstX := 15
  else
    FInstX:= FInstX + 15
end;

procedure TfqbTableArea.WMPaint(var Message: TWMPaint);
var
  i: Integer;
  
  {$IFDEF TRIAL}
  str: string;
  l, dx: integer;
  {$ENDIF}
  
begin
  inherited;
  {$IFDEF TRIAL}
  FCanvas.Font.Size := 50;
  FCanvas.Font.Color:= clRed;
  FCanvas.Font.Name := 'Tahoma';
  str := 'deretsigern';
  l := FCanvas.TextWidth(str + 'U');
  dx := (Width div 2) - (l div 2);
  FCanvas.TextOut(dx, 100, 'U');
  for i := 11 downto 1 do
    FCanvas.TextOut(FCanvas.PenPos.x, FCanvas.PenPos.y, str[i]);
  {$ENDIF}
  for i := 0 to LinkList.Count - 1 do
    LinkList[i].Draw
end;

{-----------------------  TfqbTable -----------------------}
constructor TfqbTable.Create(AOwner: TComponent);
begin
  inherited;

  Width := 130;
  Height := 150;
  BevelOuter := bvNone;
  BorderWidth := 1;
  
  FLabel := TLabel.Create(Self);
  with FLabel do
  begin
    Parent := Self;
    Align := alTop;
    Color := clActiveCaption;
    Font.Charset := DEFAULT_CHARSET;
    Font.Color := clCaptionText;
    AutoSize := False;
    Height := Height + 6;
    Font.Size := Font.Size + 1;
    Layout := tlCenter;
    SetXPStyle(FLabel);
  end;
  
  FImage := TImage.Create(Self);
  with FImage do
  begin
    Parent := Self;
    Top := 3;
    Left := 3;
    Width := 16;
    Height := 16;
    AutoSize := True;
    FImage.Picture.Bitmap.LoadFromResourceName(HInstance,'TABLEIMAGE1');
    Transparent := True;
    SetXPStyle(FImage);
  end;
  
  FButtonClose := TSpeedButton.Create(Self);
  with FButtonClose do
  begin
    Parent := Self;
    Top := 3;
    Width := 17;
    Height := 15;
    OnClick := _DoExit;
    Glyph.LoadFromResourceName(HInstance,'BTN_CLOSE');
  end;

  FButtonMinimize := TSpeedButton.Create(Self);
  with FButtonMinimize do
  begin
    Parent := Self;
    Top := 3;
    Width := 17;
    Height := 15;
    OnClick := _DoMinimize;
    Glyph.LoadFromResourceName(HInstance,'BTN_MINI');
  end;
  
  FCheckListBox := TfqbCheckListBox.Create(Self);
  with FCheckListBox do
  begin
    Parent := Self;
    Align := alClient;
    ItemHeight := 13;
    Style := lbOwnerDrawVariable;
    DragMode := dmAutomatic
  end;

  Constraints.MinHeight := FLabel.Height + 8;
  Constraints.MinWidth := 120;
  
  Caption := '';
  FFieldList := TfqbFieldList.Create(Self, TfqbField);
  DragMode := dmAutomatic;
  DoubleBuffered := true;
  ShowHint := False;
  Height := 200;
  Width := 150;

  SetXPStyle(Self);
end;

destructor TfqbTable.Destroy;
var
  i: Integer;
begin
  if GetParentForm(Self) <> nil then
  begin
    for i:= fqbCore.Grid.Items.Count - 1 downto 0 do
    begin
      if TGridColumn(fqbCore.Grid.Items[i].Data^).Table = TableName then
      begin
        FreeMem(fqbCore.Grid.Items[i].Data,SizeOf(TGridColumn));
        fqbCore.Grid.Items[i].Delete;
      end
    end;
    fqbCore.Grid.UpdateColumn
  end;
  UpdateLinkList;
  
  FLabel.Free;
  FCheckListBox.Free;
  FFieldList.Free;
  FImage.Free;
  FButtonClose.Free;
  FButtonMinimize.Free;
  
  if Parent <> nil then
  begin
    Parent.Invalidate;
    Parent:= nil
  end;
  inherited
end;

procedure TfqbTable.CreateParams(var Params: TCreateParams);
begin