uquerymaker.pas

AbsDataBase5.16 最新版

    with(T.FColumns.Objects[T.FColumns.Count - 1] as TColumnsParams) do begin
      FNameWidth := Canvas.TextWidth(S);
      FIsIndex := IsItIndex(Table, Trim(S));
      S    := LowerCase(AftToStr(Table.AdvFieldDefs[I].DataType));
      if Table.AdvFieldDefs[I].Size <> 0 then begin
        S := S + '(' + IntToStr(Table.AdvFieldDefs[I].Size) + ')'
      end;
      FType := S;
      FTypeWidth := Canvas.TextWidth(FType);
      FNameColor := ClBlack;
      FTypeColor := ClFieldType;
    end;
  end;
  T.Tag := longint(T);
  FTablesList.Add(T);
  AWidth := T.Width;
  AjustPosWidthTables(PosTable, AWidth);
  if (APos.Y = 0) and (APos.X = 0) then begin
    T.Top  := PosTable.Y;
    T.Left := PosTable.X;
  end
  else begin
    T.Top  := APos.Y;
    T.Left := APos.X;
  end;
  T.OnDblClick  := TableImageDblClick;
  T.OnDragOver  := TableImageDragOver;
  T.OnDragDrop  := TableImageDragDrop;
  T.OnPosChange := TableImagePosChange;
  T.PopupMenu   := PmTable;
  GenerateSQL(FrmMain.ReSQL);
end;

procedure TfrmQueryMaker.AjustPosWidthTables(var APos: TPoint; var AWidth: integer);
var
  I, MaxLeft, MaxTop: integer;
  MaxTopLeft: boolean;
begin
  MaxLeft := 0;
  MaxTop  := 0;
  AWidth  := 0;
  for I := 0 to FTablesList.Count - 1 do begin
    TTableImage(FTablesList[I]).SetWidthHeight;
  end;
  for I := 0 to FTablesList.Count - 1 do begin
    Application.ProcessMessages;
    if TTableImage(FTablesList[I]).Width > AWidth then begin
      AWidth := TTableImage(FTablesList[I]).Width
    end;
    MaxTopLeft := TTableImage(FTablesList[I]).Left > MaxLeft;
    if MaxTopLeft then begin
      MaxLeft := TTableImage(FTablesList[I]).Left
    end;
    if (TTableImage(FTablesList[I]).Top > MaxTop) or MaxTopLeft then begin
      MaxTop := TTableImage(FTablesList[I]).Top
    end;
  end;
  APos.X := MaxLeft + 5;
  APos.Y := MaxTop + 20;
  for I := 0 to FTablesList.Count - 1 do begin
    Application.ProcessMessages;
    TTableImage(FTablesList[I]).Width := AWidth;
  end;
  if FTablesList.Count = 1 then begin
    APos.Y := 5;
    APos.X := 5;
  end;
end;

procedure TfrmQueryMaker.FormCreate(Sender: TObject);
var
  S: string;
begin
  FCurCaption := Caption;
  FTablesBoard      := TForm.Create(Self);
  FTablesBoard.Name := 'frmBoard';
  FTablesBoard.Parent := FrmQueryMaker;
  FTablesBoard.Align := AlClient;
  FTablesBoard.BorderStyle := BsNone;
  FTablesBoard.HorzScrollBar.Range := MaxHorz;
  FTablesBoard.HorzScrollBar.Tracking := True;
  FTablesBoard.VertScrollBar.Range := MaxVert;
  FTablesBoard.VertScrollBar.Tracking := True;
  FTablesBoard.Show;
  FTablesBoard.OnDragOver := tbDragOver;
  FTablesBoard.OnDragDrop := tbDragDrop;
  FTablesList := TList.Create;
  FJoinsList  := TList.Create;
  SgColumnsInit;
  FTableCounter := 0;
  Label1.Parent := FTablesBoard;
  Label1.Left := (FTablesBoard.ClientWidth - Label1.Width) div 2;
  Label1.Top := (FTablesBoard.ClientHeight - Label1.Height) div 2;
  Label1.OnDragOver := tbDragOver;
  Label1.OnDragDrop := tbDragDrop;
  Application.OnMessage := WheelWndProc;
  cbMemory.Enabled := False;

  S := ChangeFileExt(frmMain.Settings.LastSQMFile, sqmFileExt);
  if FileExists(S) then begin
    ReadFromFile(S);
    Caption := Format(sMakerCaption, [S]);
    FCurCaption := Caption;
    GenerateSQL(FrmMain.ReSQL);
//    Visible := True;
  end
end;

procedure TfrmQueryMaker.FormDestroy(Sender: TObject);
var
  J: integer;
begin
  for J := 0 to FTablesList.Count - 1 do begin
    TTableImage(FTablesList[J]).Free
  end;
  FTablesList.Free;
  for J := 0 to FJoinsList.Count - 1 do begin
    TJoinImage(FJoinsList[J]).Free
  end;
  FJoinsList.Free;
end;

procedure TfrmQueryMaker.SgColumnsDragOver(Sender, Source: TObject; X, Y: integer; State: TDragState;
  var Accept: boolean);
begin
  Accept := (Source is TTableImage);
end;

procedure TfrmQueryMaker.SgColumnsDragDrop(Sender, Source: TObject; X, Y: integer);
begin
  AddColumn(TTableImage(Source));
end;

procedure TfrmQueryMaker.AddColumn(T: TTableImage);
var
  I, Ii, J: integer;

procedure AddSgColumn(ii, j: Integer);
begin
  SgColumns.Cells[Ii, 0] := TrimLeft(T.FColumns[J]);
  SgColumns.Cells[Ii, 1] := T.GetCaptionTable;
  SgColumns.Objects[Ii, 1] := TObject(T);
  SgColumns.Cells[Ii, 2] := T.DatabaseFileName;
  SgColumns.Cells[Ii, 3] := '';
  SgColumns.Objects[Ii, 3] := TObject(0);
  SgColumns.Cells[Ii, 4] := '';
  SgColumns.Cells[Ii, 5] := '';
  SgColumns.Cells[Ii, 6] := '';
  SgColumns.Objects[Ii, 6] := TObject(0);
  SgColumns.Cells[Ii, 7] := (T.FColumns.Objects[J] as TColumnsParams).FType;
  SgColumns.Objects[Ii, 7] := TObject(J);
  SgColumns.Cells[Ii, 8] := SFShow[0];
  SgColumns.Cells[Ii, 9] := '';
  SgColumns.Objects[Ii, 9] := TObject(0);
  SgColumns.Cells[Ii, 10] := '';
  SgColumns.Cells[Ii, 11] := T.TableAlias;
  SgColumns.Objects[Ii, 11] := TObject(T.FTableNumber);
end;

begin
  Ii := -1;
  for I := 0 to SgColumns.Colcount - 1 do begin
    if Length(SgColumns.Cells[I, 0]) = 0 then begin
      Ii := I;
      Break;
    end
  end;
  if Ii = -1 then begin
    Ii := SgColumns.Colcount;
    SgColumns.ColCount := SgColumns.Colcount + 1;
  end;
  if (T.SelectedItem < 0) then begin
    for J := 1 to T.Columns.Count - 1 do begin
      Application.ProcessMessages;
      AddSgColumn(Ii, J);
        Ii := SgColumns.Colcount;
        SgColumns.ColCount := SgColumns.Colcount + 1;
    end;
    SgColumns.ColCount := SgColumns.Colcount - 1;
  end else
  begin
    J := longint(T.SelectedItem);
    AddSgColumn(Ii, J);
  end;
  SelectColumn(Ii);
  GenerateSQL(FrmMain.ReSQL);
end;

procedure TfrmQueryMaker.TableImageDblClick(Sender: TObject);
begin
  AddColumn(Sender as TTableImage);
end;

procedure TfrmQueryMaker.SgColumnsInit;
var
  I: integer;
begin
  SelectColumn(1);
  for I := 0 to SgColumns.Rowcount - 1 do begin
    SgColumns.Cells[1, I] := ''
  end;
  SgColumns.Cells[0, 0] := SNameField;
  SgColumns.Objects[0, 0] := TObject(0);
  SgColumns.Cells[0, 1] := SNameTable;
  SgColumns.Objects[0, 1] := TObject(1);
  SgColumns.Cells[0, 2] := SDatabase;
  SgColumns.Objects[0, 2] := TObject(1);
  SgColumns.Cells[0, 3] := SSort;
  SgColumns.Objects[0, 3] := TObject(0);
  SgColumns.Cells[0, 4] := SCondition;
  SgColumns.Objects[0, 4] := TObject(0);
  SgColumns.Cells[0, 5] := SOrCond;
  SgColumns.Objects[0, 5] := TObject(1);
  SgColumns.Cells[0, 6] := SAgregate;
  SgColumns.Objects[0, 6] := TObject(0);
  SgColumns.Cells[0, 7] := STypeField;
  SgColumns.Cells[0, 8] := SVisible;
  SgColumns.Cells[0, 9] := SGroup;
  SgColumns.Objects[0, 9] := TObject(0);
  SgColumns.Cells[0, 10] := SHaving;
  SgColumns.Cells[0, 11] := SAliasTable;
  SelectColumn(SgColumns.Colcount - 1);
end;

function TfrmQueryMaker.IsValidColRow(ACol, ARow: integer): boolean;
begin
  Result := (ACol > 0) and (ARow in [3..6, 8..10]) and (SgColumns.Cells[ACol, 0] <> '');
end;

procedure TfrmQueryMaker.ResetGrouped(Col: integer);
var
  I, J, K: integer;
begin
  K := longint(SgColumns.Objects[Col, 9]);
  if K = 0 then begin
    Exit
  end;
  SgColumns.Cells[Col, 9] := '';
  SgColumns.Cells[Col, 10] := '';
  SgColumns.Objects[Col, 9] := TObject(0);
  for I := 1 to SgColumns.Colcount - 1 do begin
    Application.ProcessMessages;
    J := longint(SgColumns.Objects[I, 9]);
    if (J > K) and (J > 0) then begin
      Dec(J);
      SgColumns.Objects[I, 9] := TObject(J);
      SgColumns.Cells[I, 9]   := Format('%s_%d', [SGroup, J]);
    end;
  end;
  J := longint(SgColumns.Objects[0, 9]);
  Dec(J);
  SgColumns.Objects[0, 9] := TObject(J);
end;

procedure TfrmQueryMaker.SetGrouped;
var
  J: integer;
begin
  J := longint(SgColumns.Objects[0, 9]);
  Inc(J);
  SgColumns.Objects[0, 9] := TObject(J);
  SgColumns.Objects[SgColumns.Col, 9] := TObject(J);
  SgColumns.Cells[SgColumns.Col, 9] := Format('%s_%d', [SGroup, J]);
  GenerateSQL(FrmMain.ReSQL);
end;

procedure TfrmQueryMaker.GenerateSQL(Re: TRichEdit);
var
  I, J, K:      integer;
  TableList: TStringList;
  GroupList: TStringList;
  OrderList: TStringList;
  TableS: string;
  FieldS: string;
  WhereS: string;
  HavingS: string;
  GroupS: string;
  OrderS: string;
  CurNum: string;
  FirstWhere: boolean;
  FirstHaving: boolean;
  Ti:     TTableImage;
  SAgregate: string;
  S: string;
  Smem: string;
  Comment: string;
  StartComment: boolean;
  Lexer: TABSLexer;
  t: TToken;
  SelPos: integer;
  reText: string;
begin
  Comment := '';
  if cbSaveComments.Checked then begin
  StartComment := False;
  for I := 0 to Re.Lines.Count - 1 do begin
    if StartComment then begin
      Comment := Comment + Re.Lines[I] + #13#10;
    end else
    if (Pos('/*', Re.Lines[I]) <> 0) then begin
      StartComment := True;
      Comment := Comment + Copy(Re.Lines[I], Pos('/*', Re.Lines[I]), Length(Re.Lines[I])) + #13#10;
    end;
    if (Pos('*/', Re.Lines[I]) <> 0) then begin
      StartComment := False;
    end;
  end;
  if Length(Trim(Comment)) <> 0 then
    Comment := Comment + #13#10;
  end;

  if FTablesList.Count = 0 then begin
    if CbDistinct.Checked then begin
      S := 'SELECT DISTINCT *'#13#10
    end
    else begin
      S := 'SELECT *'#13#10
    end;
    if cbIntoTable.Checked then
    if cbMemory.Checked then begin
      S := Format('DROP TABLE IF EXISTS MEMORY %s;'#13#10, [sIntoTable]) + S;
      S := S + Format('  INTO MEMORY %s'#13#10, [sIntoTable]);
    end  else begin
      S := Format('DROP TABLE IF EXISTS %s;'#13#10, [sIntoTable]) + S;
      S := S + Format('  INTO %s'#13#10, [sIntoTable]);
    end;
    reText := Comment + S +
      Format('  FROM "%s" %s1'#13#10, [FrmMain.TCurTable.TableName, FrmMain.TCurTable.TableName[1]]);
  end else begin

  TableList := TStringList.Create;
  TableList.Sorted := True;
  TableList.Duplicates := DupIgnore;
  GroupList := TStringList.Create;
  GroupList.Sorted := True;
  OrderList := TStringList.Create;
  OrderList.Sorted := True;
  try
    WhereS      := '';
    HavingS     := '';
    FirstWhere  := True;
    FirstHaving := True;
    S      := 'SELECT ';
    if CbDistinct.Checked then begin
      S := S + 'DISTINCT '
    end;
      FieldS := S;
    for
      I := 1 to SgColumns.ColCount - 1 do begin
      if Length(SgColumns.Cells[I, 10]) <> 0 then begin
        case FirstHaving of
          False: begin
              HavingS := HavingS + Format(' AND'#13#10 + '        (%s)', [SgColumns.Cells[I, 10]])
          end;
          True: begin
            FirstHaving := False;
            HavingS     := HavingS + Format('(%s)', [SgColumns.Cells[I, 10]]);
          end;
        end
      end;
      if (Length(SgColumns.Cells[I, 4]) <> 0) and (Length(SgColumns.Cells[I, 5]) <> 0) then begin
        case FirstWhere of
          False: begin
            WhereS := WhereS + Format(' AND'#13#10 +
              '       ((%s."%s" %s) OR (%s."%s" %s))'#13#10,
              [SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 4],
              SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 5]])
          end;
          True: begin
            FirstWhere := False;
            WhereS     := WhereS + Format('((%s."%s" %s) OR (%s."%s" %s))',
              [SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 4],
              SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 5]])
          end
        end
      end
      else if Length(SgColumns.Cells[I, 4]) <> 0 then begin
        case FirstWhere of
          False: begin
            WhereS := WhereS + Format(' AND'#13#10 + '       (%s."%s" %s)',
              [SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 4]])
          end;
          True: begin
            FirstWhere := False;
            WhereS     := WhereS + Format('(%s."%s" %s)',
              [SgColumns.Cells[I, 11], SgColumns.Cells[I, 0], SgColumns.Cells[I, 4]]);
          end;
        end
      end;

      if SgColumns.Cells[I, 8] = SFShow[0] then begin
        if SgColumns.Cells[I, 7] = SCalcField then begin
          Ti     := (SgColumns.Objects[I, 1] as TTableImage);
          CurNum := (Ti.FColumns.Objects[longint(SgColumns.Objects[I, 7])] as TColumnsParams).FFormula;
          if Pos('CASE', UpperCase(CurNum)) <> 0 then begin
            FieldS := FieldS + Format('%s%sAS "%s"',
              [SgColumns.Cells[I, 6], CurNum, SgColumns.Cells[I, 0]]) + ', '
          end else