fr_cross.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

procedure TfrCrossForm.ClearSelection(Sender : TObject);
var
  i: Integer;
begin
  for i := 0 to GroupBox1.ControlCount - 1 do
    if (GroupBox1.Controls[i] <> Sender) and (GroupBox1.Controls[i] is TListBox) then
      (GroupBox1.Controls[i] as TListBox).ItemIndex := -1;
  CheckBox1.Enabled := Sender <> ListBox4;
  ComboBox2.Enabled := Sender = ListBox4;
end;

procedure TfrCrossForm.ListBox3Click(Sender: TObject);
var
  s : String;
begin
  if (FListBox <> nil) and (FListBox.ItemIndex <> -1) then
  begin
    s := FListBox.Items[FListBox.ItemIndex];
    FBusy := True;
    CheckBox1.Checked := Pos('+', s) <> 0;
    FBusy := False;
  end;
  ClearSelection(Sender);
end;

procedure TfrCrossForm.CheckBox1Click(Sender: TObject);
var
  i: Integer;
  s: String;
begin
  if FBusy then Exit;
  if (FListBox <> nil) and (FListBox.ItemIndex <> -1) then
  begin
    i := FListBox.ItemIndex;
    s := FListBox.Items[i];
    if Pos('+', s) <> 0 then
      s := Copy(s, 1, Length(s) - 1) else
      s := s + '+';
    FListBox.Items[i] := s;
    FListBox.ItemIndex := i;
  end;
  TDrawPanel(DrawPanel).Paint;
end;

procedure TfrCrossForm.ListBox4Click(Sender: TObject);
var
  s: String;
begin
  FBusy := True;
  if ListBox4.ItemIndex <> -1 then
  begin
    ComboBox2.Enabled := True;
    s := ListBox4.Items[ListBox4.ItemIndex];
    if Pos('+', s) = 0 then
      ComboBox2.ItemIndex := 0
    else
    begin
      s := AnsiLowerCase(Copy(s, Pos('+', s) + 1, 255));
      if (s = '') or (s = 'sum') then
        ComboBox2.ItemIndex := 1
      else if s = 'min' then
        ComboBox2.ItemIndex := 2
      else if s = 'max' then
        ComboBox2.ItemIndex := 3
      else if s = 'avg' then
        ComboBox2.ItemIndex := 4
      else if s = 'count' then
        ComboBox2.ItemIndex := 5
    end;
  end;
  FBusy := False;
  ClearSelection(Sender);
end;

procedure TfrCrossForm.ComboBox2Click(Sender: TObject);
var
  i: Integer;
  s: String;
begin
  if FBusy then Exit;
  if ListBox4.ItemIndex <> -1 then
  begin
    i := ListBox4.ItemIndex;
    s := PureName1(ListBox4.Items[i]);
    case ComboBox2.ItemIndex of
      0: ;
      1: s := s + '+';
      2: s := s + '+min';
      3: s := s + '+max';
      4: s := s + '+avg';
      5: s := s + '+count';
    end;
    ListBox4.Items[i] := s;
    ListBox4.ItemIndex := i;
  end;
end;

procedure TfrCrossForm.ListBox3DblClick(Sender: TObject);
begin
  CheckBox1.Checked := not CheckBox1.Checked;
end;

procedure TfrCrossForm.ListBox4DrawItem(Control: TWinControl;
  Index: Integer; ARect: TRect; State: TOwnerDrawState);
var
  s: String;
begin
  with TListBox(Control).Canvas do
  begin
    s := TListBox(Control).Items[Index];
    FillRect(ARect);
    if Pos('+', s) <> 0 then
    begin
      TextOut(ARect.Left + 1, ARect.Top, Copy(s, 1, Pos('+', s) - 1));
      s := Copy(s, Pos('+', s) + 1, 255);
      if s = '' then
        if Control = ListBox4 then
          s := 'sum' else
          s := 'total';
      TextOut(ARect.Right - TextWidth(s) - 2, ARect.Top, s);
    end
    else
      TextOut(ARect.Left + 1, ARect.Top, s);
  end;
end;

procedure TfrCrossForm.FieldsLBDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := TListBox(Source).Items.Count > 0;
end;

function GetLBIndex(LB : TListBox; s : String) : Integer;
var i : Integer;
begin
  Result := -1;
  for i := 0 to LB.Items.Count - 1 do
    If PureName1(Lb.Items[i]) = s then
    begin
      Result := i;
      Exit;
    end;
end;

procedure TfrCrossForm.FieldsLBDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  s: String;
  i: Integer;
  L4Exist: Boolean;
begin
  if (Source = Sender) and (Source <> FieldsLB) then
  begin
    i := TListBox(Source).ItemAtPos(Point(x, y), True);
    if i = -1 then
      i := TListBox(Source).Items.Count - 1;
    TListBox(Source).Items.Exchange(TListBox(Source).ItemIndex, i);
  end
  else if Source <> Sender then
  begin
    if TListBox(Source).ItemIndex = -1 then Exit;
    s := PureName1(TListBox(Source).Items[TListBox(Source).ItemIndex]);
    L4Exist := GetLBIndex(ListBox4, s) >= 0;
    if Source = FieldsLB then
      s := s + '+';
    if (not ((Source = ListBox4) and (Sender = FieldsLB))) and
       (not ((Source = FieldsLB) and (Sender <> ListBox4) and L4Exist)) then
         TListBox(Sender).Items.Add(s);
    i := GetLBIndex(FieldsLB, PureName1(s));
    if (Source = ListBox4) and (Sender <> FieldsLB) and (i <> -1) then
    begin
      FieldsLB.Items.Delete(i);
      repeat
        i := GetLBIndex(ListBox4, PureName1(s));
        if i <> -1 then ListBox4.Items.Delete(i);
      until i = -1;
    end;
    if (Source <> FieldsLB) and (Sender = ListBox4) then
      FieldsLB.Items.Add(s);
    if (not ((Source = FieldsLB) and (Sender = ListBox4))) and (not((Source = FieldsLB) and L4Exist)) then
    begin
      i := TListBox(Source).ItemIndex;
      if (i <> -1) and (Pos(PureName1(s), TListBox(Source).Items[i]) = 1) then
        TListBox(Source).Items.Delete(i);
    end;
  end;
  TDrawPanel(DrawPanel).Paint;
end;

procedure TfrCrossForm.FormShow(Sender: TObject);
var
  i: Integer;
  sl: TStringList;
  s: String;
begin
  sl := TStringList.Create;
  FillDatasetsLB;

  if Cross.Memo.Count >= 4 then
  begin
    i := DatasetsLB.Items.IndexOf(Cross.Memo[0]);
    if i <> -1 then
    begin
      DatasetsLB.ItemIndex := i;
      DatasetsLBClick(nil);

      frSetCommaText(Cross.Memo[1], sl);
      for i := 0 to sl.Count - 1 do
      begin
        s := PureName1(sl[i]);
        if FieldsLB.Items.IndexOf(s) <> -1 then
          FieldsLB.Items.Delete(FieldsLB.Items.IndexOf(s));
      end;
      ListBox2.Items.Assign(sl);

      frSetCommaText(Cross.Memo[2], sl);
      for i := 0 to sl.Count - 1 do
      begin
        s := PureName1(sl[i]);
        if FieldsLB.Items.IndexOf(s) <> -1 then
          FieldsLB.Items.Delete(FieldsLB.Items.IndexOf(s));
      end;
      ListBox3.Items.Assign(sl);

      frSetCommaText(Cross.Memo[3], sl);
      ListBox4.Items.Assign(sl);
    end;
  end
  else
  begin
    if DatasetsLB.Items.Count > 0 then
      DatasetsLB.ItemIndex := 0;
    DatasetsLBClick(nil);
    ListBox2.Clear;
    ListBox3.Clear;
    ListBox4.Clear;
  end;

  sl.Free;
end;

procedure TfrCrossForm.FormHide(Sender: TObject);
var
  i: Integer;
  s: String;
begin
  if ModalResult = mrOk then
  begin
    frDesigner.BeforeChange;
    Cross.Memo.Clear;
    Cross.Memo.Add(DatasetsLB.Items[DatasetsLB.ItemIndex]);

    s := '';
    for i := 0 to ListBox2.Items.Count - 1 do
      s := s + ListBox2.Items[i] + ';';
    Cross.Memo.Add(s);

    s := '';
    for i := 0 to ListBox3.Items.Count - 1 do
      s := s + ListBox3.Items[i] + ';';
    Cross.Memo.Add(s);

    s := '';
    for i := 0 to ListBox4.Items.Count - 1 do
      s := s + ListBox4.Items[i] + ';';
    Cross.Memo.Add(s);
  end;
end;

procedure TfrCrossForm.FormCreate(Sender: TObject);
begin
  Localize;
  DrawPanel := TDrawPanel.Create(Self);
  DrawPanel.Parent := Self;
  DrawPanel.Align := alBottom;
  DrawPanel.Height := ClientHeight - 244;
  DrawPanel.BevelOuter := bvNone;
  DrawPanel.BorderStyle := bsSingle;
end;


{ TDrawPanel }

procedure TDrawPanel.Draw(x, y, dx ,dy: Integer; s: String);
begin
  with Canvas do
  begin
    Pen.Color := clBlack;
    Rectangle(x, y, x + dx + 1, y + dy + 1);
    TextRect(Rect(x+1, y+1, x + dx-1, y + dy-1), x + 3, y + 3, s);
  end;
end;

procedure TDrawPanel.DrawColumnCells;
var
  i, StartX, CurX, CurY, CurDX, CurDY: Integer;
  s: String;
begin
  CurX := 10 + FRowFields.Count * DefDX;
  CurY := 10 + (FColumnFields.Count - 1) * DefDY;
  CurDX := DefDX; CurDY := DefDY;
  StartX := CurX;

  i := FColumnFields.Count - 1;

// create cell
  Canvas.Brush.Color := clWhite;
  Draw(CurX, CurY, CurDX, CurDY, PureName1(FColumnFields[i]));
  Dec(CurY, DefDY);
  Inc(CurDY, DefDY);
  Inc(CurX, DefDX);

  Dec(i);
  while i >= -1 do
  begin
// Header cell
    Canvas.Brush.Color := clWhite;
    if i <> -1 then
      Draw(StartX, CurY, CurDX, DefDY, PureName1(FColumnFields[i]));

// Total cell
    if (i = -1) or (Pos('+', FColumnFields[i]) <> 0) then
    begin
      Canvas.Brush.Color := $F5F5F5;
      if i <> -1 then
        s := 'Total of ' + PureName1(FColumnFields[i])
      else
      begin
        Inc(CurY, DefDY);
        Dec(CurDY, DefDY);
        Canvas.Brush.Color := clSilver;
        s := 'Grand total';
      end;
      LastX := CurX + DefDX;
      Draw(CurX, CurY, DefDX, CurDY, s);
      Inc(CurDX, DefDX);
      Inc(CurX, DefDX);
    end;
    Dec(CurY, DefDY);
    Inc(CurDY, DefDY);

    Dec(i);
  end;
end;

procedure TDrawPanel.DrawRowCells;
var
  i, StartY, CurX, CurY, CurDX, CurDY, DefDY: Integer;
begin
  DefDY := Self.DefDY;
  CurX := 10 + (FRowFields.Count - 1) * DefDX;
  CurY := 10 + FColumnFields.Count * DefDY;
  StartY := CurY;
  DefDY := 18 * FCellFields.Count;
  CurDX := DefDX; CurDY := DefDY;

  i := FRowFields.Count - 1;

// create cell
  Canvas.Brush.Color := clWhite;
  Draw(CurX, CurY, CurDX, CurDY, PureName1(FRowFields[i]));
  Dec(CurX, DefDX);
  Inc(CurY, DefDY);
  Inc(CurDX, DefDX);

  Dec(i);
  while i >= 0 do
  begin
// Header cell
    Canvas.Brush.Color := clWhite;
    Draw(CurX, StartY, DefDX, CurDY, PureName1(FRowFields[i]));

// Total cell

    if Pos('+', FRowFields[i]) <> 0 then
    begin
      Canvas.Brush.Color := $F5F5F5;
      Draw(CurX, CurY, CurDX, DefDY, 'Total of ' + PureName1(FRowFields[i]));
      Inc(CurY, DefDY);
      Inc(CurDY, DefDY);
    end;

    Dec(CurX, DefDX);
    Inc(CurDX, DefDX);
    Dec(i);
  end;

// Grand total cell
  Canvas.Brush.Color := clSilver;
  LastY := CurY + DefDY;
  Draw(CurX + DefDX, CurY, CurDX - DefDX, DefDY, 'Grand total');
end;

procedure TDrawPanel.DrawCellField;
var
  i, CurX, CurY: Integer;
begin
  CurX := 10 + FRowFields.Count * DefDX;
  CurY := 10 + FColumnFields.Count * DefDY;
  Canvas.Brush.Color := clWhite;

  for i := 0 to FCellFields.Count - 1 do
  begin
    Draw(CurX, CurY, DefDX, DefDY, PureName1(FCellFields[i]));
    Inc(CurY, DefDY);
  end;
end;

procedure TDrawPanel.DrawBorderLines(pos : byte);
begin
  Canvas.Brush.Color := clWhite;
  Canvas.Pen.Style := psDashDot;
  if Pos = 0 then
    Draw(10, 10, FRowFields.Count * DefDX, FColumnFields.Count * DefDY, '')
  else
  begin
    Canvas.MoveTo(10 + FRowFields.Count * DefDX, LastY);
    Canvas.LineTo(LastX, LastY);
    Canvas.MoveTo(LastX, 10 + FColumnFields.Count * DefDY);
    Canvas.LineTo(LastX, LastY);
  end;
  Canvas.Pen.Style := psSolid;
end;

procedure TDrawPanel.Paint;
begin
  Color := clWhite;
  inherited;
  FColumnFields := TfrCrossForm(Parent).ListBox3.Items;
  FRowFields := TfrCrossForm(Parent).ListBox2.Items;
  FCellFields := TfrCrossForm(Parent).ListBox4.Items;
  if (FColumnFields.Count < 1) or
     (FRowFields.Count < 1) or
     (FCellFields.Count < 1) then Exit;

  DefDx := 72; DefDy := 18;
  DrawBorderLines(0);
  DrawRowCells;
  DrawColumnCells;
  DrawCellField;
  DrawBorderLines(1);
end;


initialization
  frCrossForm := TfrCrossForm.Create(nil);
  frCrossList := TfrCrossList.Create;
  frRegisterObject(TfrCrossView, frCrossForm.Image1.Picture.Bitmap,
    frLoadStr(SInsertCrosstab));

finalization
  frCrossForm.Free;
  frCrossList.Free;
  frUnRegisterObject(TfrCrossView);

end.