fqbclass.pas

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

procedure TfqbCheckListBox.DragOver(Sender: TObject; X, Y: Integer; State:
               TDragState; var Accept: Boolean);
var
  int: Integer;
begin
  Accept := False;
  if ((not (Sender is TfqbCheckListBox)) or
      (Self = Sender)) then Exit;
  
  int := (Self as TfqbCheckListBox).ItemAtPos(Point(X,Y),True);
  
  if (int > (Self as TfqbCheckListBox).Items.Count - 1) or (int < 0) then
    Exit;
  
  (Self as TfqbCheckListBox).ItemIndex:= int;
  if not (Parent.Parent as TfqbTableArea).CompareFields(Parent.ComponentIndex, int, (Sender as TfqbCheckListBox).Parent.ComponentIndex, (Sender as TfqbCheckListBox).ItemIndex)
    then Exit;
  
  Accept := True
end;

{-----------------------  TfqbGrid -----------------------}
constructor TfqbGrid.Create(AOwner: TComponent);
var
  i: Integer;
  mi: TMenuItem;
begin
  inherited Create(AOwner);
  for i:= 0 to 5 do
    with Columns.Add do
    begin
      case i of
        rowColumn    : Caption := fqbGet(1820);
        rowVisibility: Caption := fqbGet(1821);
        rowWhere     : Caption := fqbGet(1822);
        rowSort      : Caption := fqbGet(1823);
        rowFunction  : Caption := fqbGet(1824);
        rowGroup     : Caption := fqbGet(1825);
      end;
      Width := 80;
    end;

  ViewStyle := vsReport;
  ColumnClick := False;
  HideSelection := False;
  Width := 300;
  DragMode := dmAutomatic;
  
  OnSelectItem := fqbOnSelectItem;
  
  FPopupMenu := TPopupMenu.Create(Self);
  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := fqbGet(1826);
  mi.OnClick := fqbOnMenu;
  mi.Tag := -1;
  FPopupMenu.Items.Add(mi);
  mi := TMenuItem.Create(FPopupMenu);
  mi.Caption := fqbGet(1827);
  mi.OnClick := fqbOnMenu;
  mi.Tag := 1;
  FPopupMenu.Items.Add(mi);
  
  FPopupMenu.OnPopup := fqbOnPopup;
  PopupMenu := FPopupMenu;
end;

destructor TfqbGrid.Destroy;
var
  i: Integer;
begin
  for i:= 0 to Items.Count - 1 do
    Dispose(PGridColumn(Items[i]));
  inherited
end;

function TfqbGrid.AddColumn: Integer;
var
  tmp: TListItem;
  p: PGridColumn;
begin
  tmp := Items.Add;
  tmp.SubItems.Add('');
  tmp.SubItems.Add('');
  tmp.SubItems.Add('');
  tmp.SubItems.Add('');
  tmp.SubItems.Add('');
  
  New(p);
  tmp.Data := p;
  
  Result:= tmp.Index
end;

procedure TfqbGrid.CreateWnd;
var
  wnd: HWND;
begin
  inherited CreateWnd;
  
  FVisibleList := TComboBox.Create(Self);
  FVisibleList.Visible := false;
  FVisibleList.Parent := Self;
  FVisibleList.Style := csOwnerDrawFixed;
  FVisibleList.ItemHeight := 12;
  FVisibleList.Items.Add(fqbGet(1828));
  FVisibleList.Items.Add(fqbGet(1829));
  FVisibleList.OnChange := fqbOnChange;
  FVisibleList.Tag := rowVisibility;
  
  FWhereEditor:= TfqbEdit.Create(Self);
  FWhereEditor.Visible := false;
  FWhereEditor.Parent := Self;
  FWhereEditor.OnChange := fqbOnChange;
  FWhereEditor.Tag := rowWhere;
  
  FSortList := TComboBox.Create(Self);
  FSortList.Visible := false;
  FSortList.Parent := Self;
  FSortList.Style := csOwnerDrawFixed;
  FSortList.ItemHeight := 12;
  FSortList.Items.Add(fqbGet(1830));
  FSortList.Items.Add(fqbGet(1831));
  FSortList.Items.Add(fqbGet(1832));
  FSortList.OnChange := fqbOnChange;
  FSortList.Tag := rowSort;
  
  FFunctionList := TComboBox.Create(Self);
  FFunctionList.Visible := false;
  FFunctionList.Parent := Self;
  FFunctionList.Style := csOwnerDrawFixed;
  FFunctionList.ItemHeight := 12;
  FFunctionList.Items.Add(fqbGet(1830));
  FFunctionList.Items.Add('AVG');
  FFunctionList.Items.Add('COUNT');
  FFunctionList.Items.Add('MAX');
  FFunctionList.Items.Add('MIN');
  FFunctionList.Items.Add('SUM');
  FFunctionList.OnChange := fqbOnChange;
  FFunctionList.Tag := rowFunction;
  
  FGroupList := TComboBox.Create(Self);
  FGroupList.Visible := False;
  FGroupList.Parent := Self;
  FGroupList.Style := csOwnerDrawFixed;
  FGroupList.ItemHeight := 12;
  FGroupList.Items.Add(fqbGet(1830));
  FGroupList.Items.Add(fqbGet(1833));
  FGroupList.OnChange := fqbOnChange;
  FGroupList.Tag := rowGroup;

  RecalcColWidth;
  
  wnd := GetWindow(Handle, GW_CHILD);
  SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG)
end;

procedure TfqbGrid.DoColumnResize(ColumnIndex, ColumnWidth: Integer);
begin
  //  RecalcColWidth;
  fqbUpdate;
  if Assigned(FEndColumnResizeEvent) then
    FEndColumnResizeEvent(Self, ColumnIndex, ColumnWidth)
end;

procedure TfqbGrid.Exchange(const AItm1, AItm2: integer);
var
  tmpStr: string;
  tmpDat: Pointer;
begin
  tmpStr := Items[AItm1].Caption;
  tmpDat := Items[AItm1].Data;
  
  Items[AItm1].Caption := Items[AItm2].Caption;
  Items[AItm1].Data := Items[AItm2].Data;
  
  Items[AItm2].Caption := tmpStr;
  Items[AItm2].Data := tmpDat;
  
  fqbUpdate;
end;

function TfqbGrid.FindColumnIndex(pHeader: pNMHdr): Integer;
var
  hwndHeader: HWND;
  ItemInfo: THdItem;
  ItemIndex: Integer;
  buf: array [0..128] of Char;
begin
  Result := -1;
  hwndHeader := pHeader^.hwndFrom;
  ItemIndex := pHDNotify(pHeader)^.Item;
  FillChar(iteminfo, SizeOf(iteminfo), 0);
  iteminfo.Mask := HDI_TEXT;
  iteminfo.pszText := buf;
  iteminfo.cchTextMax := SizeOf(buf) - 1;
  Header_GetItem(hwndHeader, ItemIndex, iteminfo);
  if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
    Result := ItemIndex
  else
  begin
    for ItemIndex := 0 to Columns.Count - 1 do
      if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
      begin
        Result := ItemIndex;
        Break;
      end
  end
end;

function TfqbGrid.FindColumnWidth(pHeader: pNMHdr): Integer;
begin
  Result := -1;
  if Assigned(PHDNotify(pHeader)^.pItem) and
    ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then
    Result := PHDNotify(pHeader)^.pItem^.cxy;
end;

procedure TfqbGrid.fqbOnChange(Sender: TObject);
var
  tmp: TcrTControl;
begin
  if Selected = nil then Exit;
  tmp := TcrTControl(Sender);
  if tmp.ClassName = 'TComboBox' then
    if TComboBox(tmp).ItemIndex = 0 then
      Selected.SubItems[tmp.tag - 1] := ''
    else
      Selected.SubItems[tmp.tag - 1] := tmp.Text;
  
  if tmp.ClassName = 'TfqbEdit' then
    Selected.SubItems[tmp.tag - 1] := tmp.Text;
  
  if tmp.tag = rowVisibility then
    TGridColumn(Selected.Data^).Visibl := (TComboBox(tmp).ItemIndex = 0);
  if tmp.tag = rowWhere then
    TGridColumn(Selected.Data^).Where := tmp.Caption;
  if tmp.tag = rowSort then
      TGridColumn(Selected.Data^).Sort := TComboBox(tmp).ItemIndex;
  if tmp.tag = rowFunction then
      TGridColumn(Selected.Data^).Func := TComboBox(tmp).ItemIndex;
  if tmp.tag = rowGroup then
      TGridColumn(Selected.Data^).Group := TComboBox(tmp).ItemIndex;
end;

procedure TfqbGrid.fqbOnMenu(Sender: TObject);
begin
  Exchange(Selected.Index, Selected.Index + (Sender as TComponent).Tag);
  Items[Selected.Index + (Sender as TComponent).Tag].Selected := True;
  UpdateColumn
end;

procedure TfqbGrid.fqbOnPopup(Sender: TObject);
begin
  if Assigned(Selected) then
  begin
    FPopupMenu.Items[0].Enabled := Selected.Index <> 0;
    FPopupMenu.Items[1].Enabled := Selected.Index <> Items.Count - 1;
  end
  else
  begin
    FPopupMenu.Items[0].Enabled := False;
    FPopupMenu.Items[1].Enabled := False;
  end
end;

procedure TfqbGrid.fqbOnSelectItem(Sender: TObject; Item: TListItem; Selected:
               Boolean);
var
  tmp: TfqbTableArea;
  tbl: TfqbTable;
  i: Integer;
begin
  fqbUpdate;
  tmp := fqbCore.TableArea;
  if not Assigned(tmp) then Exit;
  tbl := tmp.FindTable(TGridColumn(Item.Data^).Table, TGridColumn(Item.Data^).Alias);
  if not Assigned(tbl) then Exit;
  tbl.BringToFront;
  for i:= 0 to tbl.FieldList.Count - 1 do
    if tbl.FieldList[i].FieldName = TGridColumn(Item.Data^).Field then
      tbl.ChBox.ItemIndex := i;
end;

procedure TfqbGrid.fqbSetBounds(var Contr: TControl);
var
  i: Integer;
begin
  Contr.Visible := false;
  if Selected = nil then Exit;
  if Assigned(TopItem) then
    if TopItem.Index > Selected.Index then Exit;
  Contr.Width := Columns[Contr.Tag].Width + 1;
  Contr.Top := Selected.Top - 2;
  Contr.Left := 0;
  for i:= 0 to Contr.Tag - 1  do
    Contr.Left := Contr.Left + Columns[i].Width;
  Contr.Height := 19;
  if Contr.ClassName = 'TComboBox' then
    begin
      TComboBox(Contr).ItemIndex := TComboBox(Contr).Items.IndexOf(Selected.SubItems[Contr.Tag - 1]);
    end
  else
  if Contr.ClassName = 'TfqbEdit' then
    begin
      TcrTControl(Contr).Text := Selected.SubItems[Contr.Tag - 1];
    end;
  Contr.Visible := true;
end;

procedure TfqbGrid.fqbUpdate;
begin
  if not (Assigned(FVisibleList) and Assigned(FWhereEditor)
      and Assigned(FSortList) and Assigned(FFunctionList)
      and Assigned(FGroupList)) then Exit;
  fqbSetBounds(TControl(FVisibleList));
  fqbSetBounds(TControl(FWhereEditor));
  fqbSetBounds(TControl(FSortList));
  fqbSetBounds(TControl(FFunctionList));
  fqbSetBounds(TControl(FGroupList));
  FWhereEditor.Height := 18;
end;

procedure TfqbGrid.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Selected := GetItemAt(5, Y);
  ItemFocused := Selected
end;

procedure TfqbGrid.RecalcColWidth;
var
  i, n: Integer;
  w, dw: Integer;
  p: Real;
begin
  if not Assigned(FVisibleList) then
    Exit;
  w:= 0;
  n := Columns.Count - 1;
  for i := 0 to n do
    w := w + Columns[i].Width;
  dw := 0;
  for i := 0 to n do
  begin
    p :=  Columns[i].Width / w;
    Columns[i].Width := Round(p * (Width - 4));
    dw := dw + Columns[i].Width;
  end;
  Columns[n].Width := Columns[n].Width + (Width - dw - 4);
end;

procedure TfqbGrid.Resize;
begin
  inherited;
  RecalcColWidth;
  fqbUpdate
end;

procedure TfqbGrid.UpdateColumn;
var
  i: Integer;
begin
  for i:= 0 to Items.Count - 1 do
  begin
    Items[i].Caption := TGridColumn(Items[i].Data^).Field;
  
    if TGridColumn(Items[i].Data^).Visibl then
       Items[i].SubItems[rowVisibility - 1] := ''
    else
       Items[i].SubItems[rowVisibility - 1] := FVisibleList.Items[1];
  
    Items[i].SubItems[rowWhere - 1]:= TGridColumn(Items[i].Data^).Where;
  
    if TGridColumn(Items[i].Data^).Sort = 0 then
      Items[i].SubItems[rowSort - 1]:= ''
    else
      Items[i].SubItems[rowSort - 1]:= FSortList.Items[TGridColumn(Items[i].Data^).Sort];
  
    if TGridColumn(Items[i].Data^).Func = 0 then
      Items[i].SubItems[rowFunction - 1]:= ''
    else
      Items[i].SubItems[rowFunction - 1]:= FFunctionList.Items[TGridColumn(Items[i].Data^).Func];
  
    if TGridColumn(Items[i].Data^).Group = 0 then
      Items[i].SubItems[rowGroup - 1]:= ''
    else
      Items[i].SubItems[rowGroup - 1]:= FGroupList.Items[TGridColumn(Items[i].Data^).Group];
  end
end;

procedure TfqbGrid.WMNotify(var Msg: TWMNotify);
begin
  inherited;
  case Msg.NMHdr^.code of
    HDN_ENDTRACK:
      DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
  end
end;

procedure TfqbGrid.WMVscroll(var Msg: TWMNotify);
begin
  inherited;
  fqbUpdate
end;

{-----------------------  TfqbEdit -----------------------}
constructor TfqbEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPanel := TPanel.Create(Self);
  FPanel.Parent := Self;
  FPanel.Align := alRight;
  FPanel.Width := Height - 3;
  FPanel.BevelOuter := bvNone;
  
  FButton := TSpeedButton.Create(Self);
  FButton.Parent := FPanel;
  FButton.Align := alClient;
  FButton.OnClick := ButtonClick;
end;

procedure TfqbEdit.ButtonClick(Sender: TObject);
begin
  SetFocus;
  if Assigned(FOnButtonClick) then
    FOnButtonClick(Self);
end;

procedure TfqbEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or WS_CLIPCHILDREN;
end;

procedure TfqbEdit.CreateWnd;
begin
  inherited;
  ShowButton := false;
end;

procedure TfqbEdit.SetEditRect;
var
  Rec: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Rec));
  if ShowButton then
  begin
    Rec.Bottom := ClientHeight + 1;
    Rec.Right := ClientWidth - FPanel.Width - 1
  end
  else
  begin
    Rec.Bottom := ClientHeight + 1;
    Rec.Right := ClientWidth;
  end;
  Rec.Top := 0;
  Rec.Left := 0;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Rec));
end;

procedure TfqbEdit.SetShowButton(const Value: Boolean);
begin
  FShowButton := Value;
  FPanel.V