uquerymaker.pas

AbsDataBase5.16 最新版

begin
  RemoveAllTables(False);
  frmMain.Settings.LastSQMFile := FileName;
  Fs := TFileStream.Create(FileName, FmOpenRead);
  Cs := TCols.Create(Self);
  try
    Fs.Read(K, 4);
    SgColumns.ColCount := K + 1;
    for I := 0 to K do begin
      Fs.ReadComponent(Cs);
      for J := 0 to SgColumns.Rowcount - 1 do begin
        SgColumns.Cells[I, J]   := Cs.FSel[J];
        Flag := StrToIntDef(Cs.FObj[J], 0);
        SgColumns.Objects[I, J] := TObject(Flag);
        if I = 0 then
          arS[J] := Flag;
      end;
    end;
    CbDistinct.Checked := arS[0] = 1;
    cbLowerCase.Checked := arS[1] = 1;
    cbDoubleQuotes.Checked := arS[2] = 1;
    cbIntoTable.Checked := arS[4] = 1;
    cbSaveComments.Checked := arS[5] = 1;
    cbMemory.Enabled := cbIntoTable.Checked;
    cbMemory.Checked := arS[6] = 1;
    Fs.Position := Fs.Position + 1;
    Fs.Read(K, 4);
    for I := 0 to K do begin
      Ji := TJoinImage.Create(Self);
      with Ji do begin
        ReadFromFile(Fs);
        Parent      := FTablesBoard;
        OnMouseDown := tbMouseDown;
        OnDragOver  := tbDragOver;
        OnDragDrop  := tbDragDrop;
        PopupMenu   := PmJoin;
      end;
      FJoinsList.Add(Ji);
    end;
    Fs.Position := Fs.Position + 1;
    Fs.Read(K, 4);
    for J := 0 to K do begin
      Ti := TTableImage.Create(Self);
      Ti.ReadFromFile(Fs);
      Inc(FTableCounter);
      for I := 1 to SgColumns.ColCount - 1 do begin
        if longint(SgColumns.Objects[I, 1]) = Ti.Tag then begin
          SgColumns.Objects[I, 1] := TObject(longint(Ti))
        end;
      end;
      for I := 0 to FJoinsList.Count - 1 do begin
        if TJoinImage(FJoinsList[I]).FFromTableJoin = Ti.Tag then begin
          TJoinImage(FJoinsList[I]).FFromTableJoin := longint(Ti)
        end;
        if TJoinImage(FJoinsList[I]).FToTableJoin = Ti.Tag then begin
          TJoinImage(FJoinsList[I]).FToTableJoin := longint(Ti)
        end;
      end;
      with Ti do begin
        Tag    := longint(Ti);
        Parent := FTablesBoard;
        OnDblClick := TableImageDblClick;
        OnDragOver := TableImageDragOver;
        OnDragDrop := TableImageDragDrop;
        OnPosChange := TableImagePosChange;
        PopupMenu := PmTable;
      end;
      FTablesList.Add(Ti);
    end;
  finally
    Fs.Free;
    Cs.Free;
    SelectColumn(1);
  end;
end;

procedure TfrmQueryMaker.RemoveAllTables(LblShow: boolean);
var
  I: integer;
begin
  frmMain.Settings.LastSQMFile := '';
  frmQueryMaker.Caption := Format(sMakerCaption, [sNewProject]);
  CbDistinct.Checked := False;
  SgColumns.Objects[0, 0] := TObject(0);
  cbLowerCase.Checked := True;
  SgColumns.Objects[0, 1] := TObject(1);
  cbDoubleQuotes.Checked := True;
  SgColumns.Objects[0, 2] := TObject(1);
  cbIntoTable.Checked := False;
  SgColumns.Objects[0, 4] := TObject(0);
  cbMemory.Checked := False;
  cbMemory.Enabled := False;
  SgColumns.Objects[0, 6] := TObject(0);
  cbSaveComments.Checked := True;
  SgColumns.Objects[0, 5] := TObject(1);
  for I := SgColumns.ColCount - 1 downto 1 do begin
    Application.ProcessMessages;
    DeleteColumn(I);
  end;
  for I := FJoinsList.Count - 1 downto 0 do begin
    Application.ProcessMessages;
    TJoinImage(FJoinsList[I]).Free;
    FJoinsList.Delete(I);
  end;
  for I := FTablesList.Count - 1 downto 0 do begin
    Application.ProcessMessages;
    TTableImage(FTablesList[I]).Free;
    FTablesList.Delete(I);
  end;
  FTableCounter := 0;
  FTablesBoard.HorzScrollBar.Position := 0;
  FTablesBoard.VertScrollBar.Position := 0;
  GenerateSQL(FrmMain.ReSQL);
  Label1.Visible := LblShow;
end;

procedure TTableImage.ColumnsChange(Sender: TObject);
begin
  Invalidate;
end;

constructor TTableImage.Create(AOwner: TComponent);
begin
  inherited;
  FColumns := TStringList.Create;
  TStringList(FColumns).OnChange := ColumnsChange;
  FSelItem := -1;
end;

destructor TTableImage.Destroy;
var
  I: integer;
begin
  for I := 0 to FColumns.Count - 1 do begin
    FColumns.Objects[I].Free
  end;
  FColumns.Free;
  inherited;
end;

function TTableImage.GetCaptionTable: TCaption;
begin
  Result := Caption;
end;

function TTableImage.GetSelItem(Y: integer): integer;
var
  Item: integer;
begin
  if Y <= FHeaderHeight then begin
    Result := -1;
    Exit;
  end;
  Item := Y - FHeaderHeight;
  try
    Item := Item div (Canvas.Textheight('Wj')+2);
  except
    Item := -1;
  end;
  if (Item > FColumns.Count - 1) or (Item < 0) then begin
    Item := -1
  end;
  Result := Item;
end;

function TTableImage.GetMaxHeight: integer;
begin
  Result := (FColumns.Count + 1) * (Canvas.TextHeight('Wj') + 2) + 3;
end;

function TTableImage.GetMaxWidth: integer;
var
  I, NameWidth, TypeWidth: integer;
  T1, T2: integer;
begin
  NameWidth := 0;
  TypeWidth := 0;
  for I := 0 to FColumns.Count - 1 do begin
    T1 := (FColumns.Objects[I] as TColumnsParams).FNameWidth;
    if T1 > NameWidth then begin
      NameWidth := T1
    end;
    T2 := (FColumns.Objects[I] as TColumnsParams).FTypeWidth;
    if T2 > TypeWidth then begin
      TypeWidth := T2
    end;
  end;
  Result := NameWidth + TypeWidth + 12;
  if result < Canvas.TextWidth(Caption) then
    result := Canvas.TextWidth(Caption) + 6;
end;

function TTableImage.GetTableAlias: string;
begin
  Result := CaptionTable[1] + IntToStr(FTableNumber);
end;

procedure TTableImage.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: integer);
const
  SC_DragMove = $F012;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Y <= FHeaderHeight) then begin
    ReleaseCapture;
    Perform(WM_SysCommand, SC_DragMove, 0);
    Exit;
  end;
  if (Y > FHeaderHeight) and (GetSelItem(Y) > -1) and (Button = Mbleft) then begin
    BeginDrag(True);
  end;
end;

procedure TTableImage.MouseEnter(var Msg: Tmessage);
begin
  FMouseIn      := True;
end;

procedure TTableImage.MouseLeave(var Msg: TMessage);
begin
  FMouseIn := False;
  if FClearSel then begin
    Canvas.Pen.Color   := ClSelectedField;
    Canvas.Brush.Color := ClSelectedField;
    Canvas.Pen.Mode    := PmNotXor;
    Canvas.Rectangle(1, FlastPosYTop, Width - 1, FlastPosYBottom);
    FClearSel := False;
  end;
end;

procedure TTableImage.MouseMove(Shift: TShiftState; X, Y: integer);
var
  Msg: TMessage;
begin
  inherited MouseMove(Shift, X, Y);
  if FmouseIn then begin
    if Y <= FHeaderHeight then begin
      MouseLeave(Msg);
      FmouseIn := True;
      FSelItem := -1;
    end else begin
      FSelItem := GetSelItem(Y);
      if FSelItem > - 1 then begin
        Canvas.Pen.Color   := ClSelectedField;
        Canvas.Brush.Color := ClSelectedField;
        Canvas.Pen.Mode    := PmNotXor;
        if FClearSel then
          Canvas.Rectangle(1, FlastPosYTop, Width - 1, FlastPosYBottom);
        FlastPosYBottom := (FColumns.Objects[FSelItem] as TColumnsParams).FCoord.Y + Canvas.TextHeight('Wj') + 2;
        FlastPosYTop   := (FColumns.Objects[FSelItem] as TColumnsParams).FCoord.Y;
        Canvas.Rectangle(1, FlastPosYTop, Width - 1, FlastPosYBottom);
        FClearSel := True;
      end
    end;
  end;
end;

procedure TTableImage.SetWidthHeight;
var
  I: integer;
begin
  for I := 0 to FColumns.Count - 1 do begin
    Application.ProcessMessages;
    (FColumns.Objects[I] as TColumnsParams).FCoord.X := 3;
    (FColumns.Objects[I] as TColumnsParams).FCoord.Y := (I + 1) * (Self.Canvas.TextHeight('Wj') + 2) + 2;
  end;
  Width  := GetMaxWidth;
  Height := GetMaxHeight;
end;

procedure TTableImage.Paint;
var
  Image: TBitmap;
  Hdr, Tx, Ty, I, Mxl, Mxl2: integer;
  Txt1:  string;
begin
  FClearSel := False;
  Image    := TBitmap.Create;
  try
    with Image, Image.Canvas do begin
      Width  := Self.Width;
      Height := Self.Height;
      Brush.Color := Self.Color;
      FillRect(Self.ClientRect);
      Pen.Color := ClBasicTable;
      Brush.Color := ClWhite;
      Hdr := FHeaderHeight - 1;
      RoundRect(0, 0, Self.Width, Self.Height, 8, 8);
      MoveTo(1, Hdr);
      LineTo(Width-1, Hdr);
      Brush.Color := ClBasicTable;
      Tx := 3;
      Ty := 2;
      FloodFill(2, 2, Pen.Color, FsBorder);
      Brush.Style := BsClear;
      Font.Color  := ClWhite;
      Font.Style  := [FsBold];
      TextOut(Tx, Ty, Caption);
      Font.Color := ClBlack;
      Font.Style := [];
      Mxl2 := 0;
      for I := 0 to FColumns.Count - 1 do begin
        Mxl := (FColumns.Objects[I] as TColumnsParams).FTypeWidth;
        if Mxl > Mxl2 then begin
          Mxl2 := Mxl
        end;
      end;
      for I := 0 to FColumns.Count - 1 do begin
        Ty   := (FColumns.Objects[I] as TColumnsParams).FCoord.Y;
        Txt1 := FColumns[I];
        if Ty < (Height - TextHeight(Txt1) - 1) then begin
          Tx := (FColumns.Objects[I] as TColumnsParams).FCoord.X;
          Font.Color := (FColumns.Objects[I] as TColumnsParams).FNameColor;
          if (FColumns.Objects[I] as TColumnsParams).FIsIndex then begin
            Brush.Color := ClIndexField;
            Pen.Style   := PsClear;
            RoundRect(1, Ty, Width, Ty + Hdr, 6, 4);
          end;
          Brush.Style := BsClear;
          TextOut(Tx, Ty, Txt1);
          Tx := Width - Mxl2 - 4;
          Font.Color := (FColumns.Objects[I] as TColumnsParams).FTypeColor;
          TextOut(Tx, Ty, (FColumns.Objects[I] as TColumnsParams).FType);
        end;
      end;
      Pen.Style   := PsSolid;
      MoveTo(Width - Mxl2 - 7, FHeaderHeight);
      Lineto(Width - Mxl2 - 7, Height-1);
      Self.Canvas.Draw(0, 0, Image);
    end;
  finally
    Image.Free;
  end;
end;

procedure TTableImage.ReadFromFile(Fs: TFileStream);
var
  I:  integer;
  Cp: TColumnsParams;
begin
  Fs.ReadComponent(Self);
  for I := 0 to FColumns.Count - 1 do begin
    Cp := TColumnsParams.Create(Self);
    Cp.ReadFromFile(Fs);
    FColumns.Objects[I] := Cp;
  end;
end;

procedure TTableImage.SetCaptionTable(const Value: TCaption);
begin
  if Value <> Caption then begin
    Caption := Value;
    Invalidate;
  end;
end;

procedure TTableImage.WMWINDOWPOSCHANGED(var Msg: Tmessage);
begin
  inherited;
  if Top < 0 then begin
    Top := 1
  end;
  if Left < 0 then begin
    Left := 1
  end;
  if Assigned(FonPosChange) then begin
    FOnPosChange(Self, Top, Left)
  end;
end;

procedure TTableImage.WriteToFile(Fs: TFileStream);
var
  I: integer;
begin
  Fs.WriteComponent(Self);
  for I := 0 to FColumns.Count - 1 do begin
    TColumnsParams(FColumns.Objects[I]).WriteToFile(Fs);
  end;
end;

constructor TColumnsParams.Create;
begin
  inherited;
  FIsIndex := False;
  FFormula := '';
  FIsCalc  := False;
end;

procedure TfrmQueryMaker.SgColumnsSelectCell(Sender: TObject; ACol, ARow: integer; var CanSelect: boolean);
begin
  CanSelect := IsValidColRow(ACol, ARow);
end;

procedure TfrmQueryMaker.DeleteColumn(ColNo: integer);
var
  I, Ii: integer;
begin
  ResetSort(ColNo);
  ResetGrouped(ColNo);