frd_form.pas

FASTREPORT报表工具,可以迅速制作报表.

    if Self.Cursor = crSizeNWSE then
      if (CT = ct1) or Cont(Left - 2, Top - 2, LastX, LastY) then
      begin
        SetBounds(Left + kx, Top + ky, Width - kx, Height - ky);
        CT := ct1;
      end
      else
        SetBounds(Left, Top, Width + kx, Height + ky);
    if Self.Cursor = crSizeNESW then
      if (CT = ct2) or Cont(Left + Width + 2, Top - 2, LastX, LastY) then
      begin
        SetBounds(Left, Top + ky, Width + kx, Height - ky);
        CT := ct2;
      end
      else
        SetBounds(Left + kx, Top, Width - kx, Height + ky);
    if Self.Cursor = crSizeWE then
      if (CT = ct3) or Cont(Left - 2, Top + Height div 2, LastX, LastY) then
      begin
        SetBounds(Left + kx, Top, Width - kx, Height);
        CT := ct3;
      end
      else
        SetBounds(Left, Top, Width + kx, Height);
    if Self.Cursor = crSizeNS then
      if (CT = ct4) or Cont(Left + Width div 2, Top, LastX, LastY) then
      begin
        SetBounds(Left, Top + ky, Width, Height - ky);
        CT := ct4;
      end
      else
        SetBounds(Left, Top, Width, Height + ky);
    Inc(LastX, kx);
    Inc(LastY, ky);
    frDesigner.Modified := True;
  end;
end;

procedure TPaintPanel.MDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i, j: Integer;
  c, c1: TControl;
  f: Boolean;
begin
  if not IsDesigning then Exit;
  if DClick then
  begin
    DClick := False;
    exit;
  end;
  ClearSelection;
  if Cursor = crArrow then
  begin
    f := True; c1 := nil;
    for i := ControlCount - 1 downto 0 do
    begin
      c := Controls[i];
      if PtInRect(c.BoundsRect, Point(X, Y)) then
      begin
        c1 := c;
        for j := 0 to SelList.Count-1 do
          if SelList[j] = c then
          begin
            if ssShift in Shift then
              SelList.Delete(j);
            f := False;
            break;
          end;
        break;
      end;
    end;
    if f then
    begin
      if not (ssShift in Shift) or (c1 = nil) then SelList.Clear;
      if c1 <> nil then SelList.Add(c1);
    end;
  end;
  Down := True;
  LastX := X;
  LastY := Y;
  OldRect := Rect(X, Y, X, Y);
end;

procedure TPaintPanel.MUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
  c: TControl;
begin
  if not IsDesigning then Exit;
  Down := False;
  if SelList.Count = 0 then
  begin
    Canvas.DrawFocusRect(OldRect);
    for i := 0 to ControlCount - 1 do
    begin
      c := Controls[i];
      with OldRect do
      if not ((c.Left > Right) or (c.Left + c.Width < Left) or
              (c.Top > Bottom) or (c.Top + c.Height < Top)) then
        SelList.Add(c);
    end;
  end;
  for i := 0 to SelList.Count - 1 do
    DrawSelection(TControl(SelList[i]));
  CT := ctNone;
end;

procedure TPaintPanel.MDblClick(Sender: TObject);
var
  PropForm: TfrPropForm;
  i: Integer;
  b: Boolean;
  c, c1: TControl;
begin
  if not IsDesigning or (SelList.Count = 0) then Exit;
  Down := False;
  DClick := True;
  b := False;
  c1 := SelList[0];
  for i := 0 to SelList.Count-1 do
  begin
    c := SelList[i];
    if c.ClassName <> c1.ClassName then
      b := True;
  end;
  if b then Exit;
  PropForm := TfrPropForm.Create(nil);
  with PropForm do
  begin
    ShowModal;
    frDesigner.Modified := True;
    Free;
  end;
  Repaint;
end;

{-----------------------------------------------------------------------------}
procedure TfrParamsDialogForm.FormShow(Sender: TObject);
begin
  IsDesigning := Designing;
  Panel1.Visible := IsDesigning;
  PlaceControls;
end;

procedure TfrParamsDialogForm.FormHide(Sender: TObject);
begin
  SelList.Clear;
  if not IsDesigning then
    b.Free;
  GetControlsInfo;
end;

procedure TfrParamsDialogForm.FormResize(Sender: TObject);
begin
  Repaint;
end;

{$HINTS OFF}
procedure TfrParamsDialogForm.PlaceControls;
var
  i, n: Integer;
  p: PfrParamInfo;
  c: TControl;

  procedure FillProperties(c: THackControl; p: PfrControlInfo);
  begin
    c.Parent := PaintPanel;
    with p^, c do
    begin
      if TControl(c) is TLabel then
      begin
        TLabel(c).AutoSize := Bounds.Right = 0;
        TLabel(c).WordWrap := Bounds.Right <> 0;
      end;
      with Bounds do
        SetBounds(Left, Top, Right, Bottom);
      c.Caption := p.Caption;
      Font.Name := FontName;
      Font.Size := FontSize;
      Font.Style := frSetFontStyle(FontStyle);
{$IFNDEF Delphi2}
      Font.Charset := FontCharset;
{$ENDIF}
      Font.Color := FontColor;
      if IsDesigning then
        Cursor := crArrow;
    end;
  end;

begin
  for i := 0 to PaintPanel.ControlCount - 1 do
    PaintPanel.Controls[0].Free;
  ClientWidth := ParamFormWidth; ClientHeight := ParamFormHeight;
  for i := 0 to frParamList.Count - 1 do
  begin
    p := frParamList[i];
    c := TfrDesignLabel.Create(PaintPanel);
    FillProperties(THackControl(c), @p^.LabelControl);
    c.Tag := i;

    n := p^.QueryRef.frParams.ParamIndex(p^.ParamName);
    case p^.Typ of
      ptEdit:
{$IFDEF UseDateEdit}
        if p^.QueryRef.frParams.ParamType[n] in [ftDate, ftDateTime] then
          c := TfrDesignDateEdit.Create(PaintPanel) else
{$ENDIF}
          c := TfrDesignEdit.Create(PaintPanel);
      ptLookup: c := TfrDesignLookup.Create(PaintPanel);
      ptCombo: c := TfrDesignCombo.Create(PaintPanel);
    end;
    FillProperties(THackControl(c), @p^.EditControl);
    c.Tag := i;
    if p^.Typ = ptLookup then
      with c as TfrDesignLookup do
      begin
        ListSource := frFindComponent(nil, p^.LookupDS) as TDataSource;
        KeyField := p^.LookupKF;
        ListField := p^.LookupLF;
      end
    else if p^.Typ = ptCombo then
      with c as TfrDesignCombo do
      begin
        Style := csOwnerDrawFixed;
        OnDrawItem := ComboBoxDrawItem;
        Items.Assign(p^.ComboStrings);
      end;
  end;
  if not IsDesigning then
  begin
    b := TButton.Create(Self);
    b.Parent := PaintPanel;
    b.SetBounds((PaintPanel.Width - 75) div 2, PaintPanel.Height - 33, 75, 25);
    b.Caption := 'OK';
    b.ModalResult := mrOk;
    b.Default := True;
  end;
end;
{$HINTS ON}

{$WARNINGS OFF}
procedure TfrParamsDialogForm.GetControlsInfo;
var
  i: Integer;
  p: PfrParamInfo;
  p1: PfrControlInfo;
  c: TControl;
begin
  for i := 0 to PaintPanel.ControlCount - 1 do
  begin
    c := PaintPanel.Controls[i];
    p := frParamList[c.Tag];
    if c is TLabel then
      p1 := @p^.LabelControl
    else if (c is TEdit) or (c is TDBLookupComboBox)
{$IFDEF UseDateEdit}
{$IFDEF RX}
      or (c is TDateEdit)
{$ELSE}
      or (c is TDateTimePicker)
{$ENDIF}
{$ENDIF}
      or (c is TComboBox) then
      p1 := @p^.EditControl
    else
      continue;
    with p1^, THackControl(c) do
    begin
      Bounds := Rect(Left, Top, Width, Height);
      if c is TLabel then
        if TLabel(c).AutoSize then
          Bounds.Right := 0;
      p1.Caption := THackControl(c).Caption;
      FontName := Font.Name;
      FontSize := Font.Size;
      FontStyle := frGetFontStyle(Font.Style);
{$IFNDEF Delphi2}
      FontCharset := Font.Charset;
{$ENDIF}
      FontColor := Font.Color;
    end;
    p^.Typ := ptEdit;
    if c is TDBLookupComboBox then
      with p^, c as TDBLookupComboBox do
      begin
        Typ := ptLookup;
        LookupDS := '';
        if ListSource <> nil then
          LookupDS := ListSource.Owner.Name + '.' + ListSource.Name;
        LookupKF := KeyField;
        LookupLF := ListField;
        if not IsDesigning then
          p1^.Caption := ListSource.DataSet.FieldByName(KeyField).AsString;
      end
    else if c is TComboBox then
      with p^, c as TComboBox do
      begin
        Typ := ptCombo;
        ComboStrings.Assign((c as TComboBox).Items);
        if not IsDesigning then
          if Pos(';', p1^.Caption) <> 0 then
            p1^.Caption := Trim(Copy(p1^.Caption, Pos(';', p1^.Caption) + 1, 255));
      end;
  end;
  ParamFormWidth := ClientWidth; ParamFormHeight := ClientHeight;
end;
{$WARNINGS ON}

procedure TfrParamsDialogForm.Gr4BClick(Sender: TObject);
begin
  PaintPanel.Repaint;
end;

procedure TfrParamsDialogForm.CloseBClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TfrParamsDialogForm.ComboBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  ComboBox: TComboBox;
  s: String;
begin
  ComboBox := Control as TComboBox;
  with ComboBox.Canvas do
  begin
    FillRect(Rect);
    s := ComboBox.Items[Index];
    if Pos(';', s) <> 0 then
      s := Copy(s, 1, Pos(';', s) - 1);
    TextOut(Rect.Left + 2, Rect.Top + 1, s);
  end;
end;

procedure TfrParamsDialogForm.FormCreate(Sender: TObject);
begin
  Caption := frLoadStr(frRes + 3150);
  Gr4B.Hint := frLoadStr(frRes + 3151);
  Gr8B.Hint := frLoadStr(frRes + 3152);
  GrAlignB.Hint := frLoadStr(frRes + 3153);
  CloseB.Caption := frLoadStr(frRes + 3154);
end;

initialization
  frParamsDialogForm := TfrParamsDialogForm.Create(nil);
  PaintPanel := TPaintPanel.Create(frParamsDialogForm);
  SelList := TList.Create;

finalization
  PaintPanel.Free;
  frParamsDialogForm.Free;
  SelList.Free;

end.