tntqrctrls.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

              QRPrinter.YPos(aTop + aHeight + AFExpanded)));
          end;
      end
      else
        Result := false;
    end;
  end;

  procedure PrintLine(LineNumber: Integer);
  begin
    if ParentReport.FinalPass and (Length(FFormattedLines[LineNumber]) > 0) then
    begin
      if Win9xFarEast and (QRPrinter.Destination = qrdMetaFile) then
        BugFixExtTextOutW(aCanvas.Handle, QRPrinter.XPos(X), QRPrinter.YPos(Y),
          Flags, @aRect, @FFormattedLines[LineNumber][1], length(FFormattedLines[LineNumber]),
          nil)
      else
        ExtTextOutW(aCanvas.Handle, QRPrinter.XPos(X), QRPrinter.YPos(Y),
          Flags, @aRect, @FFormattedLines[LineNumber][1], length(FFormattedLines[LineNumber]),
          nil);
    end;
    if ParentReport.Exporting then
      ParentReport.ExportFilter.TextOut(X, Y, Font, Color, AAlignment,
        FFormattedLines[LineNumber]);
    Y := Y + LineHeight;
  end;

begin
  Flags := 0;
  AFExpanded := 0;
  OrgWidth := aWidth;
  HasSaved := false;
  if (FPrintCaption <> '') and assigned(FOnPrint) then
  begin
    SavedCaption := FPrintCaption;
    NewCaption := FPrintCaption;
    FOnPrint(Self, NewCaption);

    if Font <> aCanvas.Font then
    begin
      aCanvas.Font := Font;
      aHeight := Size.Height;
      LineHeight := aCanvas.TextHeight('W') / QRPrinter.YFactor;
    end;

    if NewCaption <> FPrintCaption then
    begin
      FPrintCaption := NewCaption;
      FormatLines;
      HasSaved := true;
    end;
  end;
  FormatLines;

  aWidth := Size.Width;
  if ParentReport.FinalPass and not Transparent then
    with aCanvas do
    begin
      Pen.Width := 0;
      Brush.Color := Color;
      Brush.Style := bsSolid;
      FillRect(rect(QRPrinter.XPos(aLeft),
        QRPrinter.YPos(aTop),
        QRPrinter.XPos(aLeft + aWidth),
        QRPrinter.YPos(aTop + aHeight)));
    end;
  if ParentReport.FinalPass then
    if not AutoSize then
      ;

  if Frame.AnyFrame then
  begin
    if Frame.DrawTop then
      aTop := aTop + round(Frame.Width / 72 * 254);
    if Frame.DrawLeft then
      aLeft := aLeft + round(Frame.Width / 72 * 254)
  end;

  aRect := Rect(0, 0, QRPrinter.XSize(aWidth), QRPrinter.YSize(LineHeight));

  AAlignment := Alignment;
  if UseRightToLeftAlignment then
    ChangeBiDiModeAlignment(AAlignment);

  ControlBottom := aTop + aHeight + 1;
  Y := aTop;
  if not AutoSize then
    X := aLeft
  else
  begin
    case Alignment of
      TaLeftJustify: X := aLeft;
      TaRightJustify: X := aLeft - (aWidth - OrgWidth);
      TaCenter: X := aLeft - ((aWidth - OrgWidth) / 2);
    end;
  end;

  SetBkMode(aCanvas.Handle, Windows.Transparent);

  TAFlags := TA_Top + TA_NoUpdateCP;
  AAlignment := Alignment;
  if UseRightToLeftAlignment then
    ChangeBiDiModeAlignment(AAlignment);
  if UseRightToLeftReading then
  begin
    Flags := Flags or ETO_RTLREADING;
    TAFlags := TAFlags + TA_RTLREADING;
  end;
  case AAlignment of
    TaLeftJustify: SetTextAlign(aCanvas.Handle, TA_Left + TAFlags);
    TaRightJustify:
      begin
        SetTextAlign(aCanvas.Handle, TA_Right + TAFlags);
        X := X + aWidth;
      end;
    TaCenter:
      begin
        SetTextAlign(aCanvas.Handle, TA_Center + TAFlags);
        X := X + aWidth / 2;
      end;
  end;

  HasExpanded := false;
  if PrintFinished then
    FCurrentLine := 0;

  while (FCurrentLine <= FFormattedLines.Count - 1) and CanPrint do
  begin
    PrintLine(FCurrentLine);
    inc(FCurrentLine);
  end;

  if (FCurrentLine <= FFormattedLines.Count - 1) and AutoStretch then
    PrintFinished := false
  else
    PrintFinished := true;
  SelectClipRgn(QRPrinter.Canvas.Handle, 0);

  if HasSaved then
    FPrintCaption := SavedCaption;

  if ParentReport.FinalPass and Frame.AnyFrame then
    THackQRFrame(Frame).PaintIt(aCanvas,
      rect(QRPrinter.XPos(ALeft),
      QRPrinter.YPos(ATop),
      QRPrinter.XPos(ALeft + aWidth),
      QRPrinter.YPos(Atop + Size.height + AFExpanded)),
      QRPrinter.XFactor,
      QRPrinter.YFactor);
end;

procedure TTntQRCustomLabel.Prepare;
begin
  inherited;
  Caption := Copy(Caption, 1, Length(Caption)); // Refresh caption
end;

procedure TTntQRCustomLabel.Print(OfsX, OfsY: Integer);
var
  aCanvas: TCanvas;
begin
  if IsEnabled then
  begin
    aCanvas := QRPrinter.Canvas;
    aCanvas.Font := Font;
    with QRPrinter do
      PrintToCanvas(QRPrinter.Canvas,
        OfsX + Size.Left, OfsY + Size.Top,
        Size.Width, Size.Height,
        aCanvas.TextHeight('W') / QRPrinter.YFactor, AutoStretch);
  end;
end;

procedure TTntQRCustomLabel.SetCaption(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
  FPrintCaption := Value;
  FormatLines;
  Invalidate;
end;

procedure TTntQRCustomLabel.SetLines(const Value: TTntStrings);
begin
  FLines.Assign(Value);
  FormatLines;
  Invalidate;
end;

procedure TTntQRCustomLabel.PaintToCanvas(aCanvas: TCanvas; aRect: TRect;
  CanExpand: Boolean; LineHeight: Integer);
var
  I: Integer;
  StartX: Integer;
  StartY: Integer;
  Cap: WideString;
  VPos: Integer;
  Flags: Integer;
  AAlignment: TAlignment;
begin
  FormatLines;
  Flags := 0;
  if not Transparent then
  begin
    aCanvas.Brush.Color := Color;
    aCanvas.Brush.Style := bsSolid;
    aCanvas.Fillrect(aRect);
  end;
  StartY := aRect.Top;
  StartX := aRect.Left;
  if Frame.AnyFrame then
  begin
    if Frame.DrawTop and (Frame.Width > 0) then
      StartY := StartY + round(Frame.Width / 72 * Screen.PixelsPerInch * Zoom / 100);
    if Frame.DrawLeft then
      StartX := StartX + round(Frame.Width / 72 * Screen.PixelsPerInch * Zoom / 100)
  end;
  aRect.Right := aRect.Right - aRect.Left;
  aRect.Left := 0;
  aRect.Bottom := aRect.Bottom - aRect.Top;
  aRect.Top := 0;
  SetBkMode(aCanvas.Handle, Windows.Transparent);
  begin
    AAlignment := Alignment;
    if UseRightToLeftAlignment then
      ChangeBiDiModeAlignment(AAlignment);
    case AAlignment of
      TaLeftJustify: SetTextAlign(aCanvas.Handle, TA_Left + TA_Top + TA_NoUpdateCP);
      TaRightJustify:
        begin
          SetTextAlign(aCanvas.Handle, TA_Right + TA_Top + TA_NoUpdateCP);
          StartX := StartX + aRect.Right;
        end;
      TaCenter:
        begin
          SetTextAlign(aCanvas.Handle, TA_Center + TA_Top + TA_NoUpdateCP);
          StartX := StartX + (aRect.Right - aRect.Left) div 2;
        end;
    end;
  end;
  for I := 0 to FFormattedLines.Count - 1 do
  begin
    VPos := StartY + I * LineHeight;
    begin
      Cap := FFormattedLines[I];
      if Length(Cap) > 0 then
        ExtTextOutW(aCanvas.Handle, StartX, VPos, Flags, @aRect, @Cap[1], length(Cap), nil);
    end;
  end;
end;

function TTntQRCustomLabel.GetCaptionBased: Boolean;
begin
  Result := True;
end;

procedure TTntQRCustomLabel.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := (csSetCaption in ControlStyle) and
    not (csLoading in ComponentState) and (Name = Caption) and
    ((Owner = nil) or not (Owner is TControl) or
    not (csLoading in TControl(Owner).ComponentState));
  inherited SetName(Value);
  if ChangeText then
    Caption := Value;
end;

{ TTntQRMemo }

function TTntQRMemo.GetCaptionBased: Boolean;
begin
  Result := False;
end;

procedure TTntQRMemo.Paint;
begin
  if (Lines.Count > 0) and (Caption <> '') then
    FPrintCaption := '';
  inherited Paint;
end;

procedure TTntQRMemo.Print(OfsX, OfsY: Integer);
begin
  Caption := '';
  inherited Print(OfsX, OfsY);
  Caption := Name;
end;

{ TTntQRDBText }

constructor TTntQRDBText.Create(AOwner: TComponent);
begin
  inherited;
  DataSourceName := '';
  IsMemo := false;
end;

function TTntQRDBText.GetCaptionBased: Boolean;
begin
  Result := not IsMemo;
end;

procedure TTntQRDBText.Loaded;
var
  aComponent: TComponent;
begin
  inherited Loaded;
  if DataSourceName <> '' then
  begin
    aComponent := Owner.FindComponent(DataSourceName);
    if (aComponent <> nil) and (aComponent is TDataSource) then
      DataSet := TDataSource(aComponent).DataSet;
  end;
end;

procedure TTntQRDBText.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
    if AComponent = FDataSet then
      FDataSet := nil;
end;

procedure TTntQRDBText.Prepare;
begin
  inherited Prepare;
  if Assigned(FDataSet) then
  begin
    Field := FDataSet.FindField(FDataField);
    if Field <> nil then
    begin
      FieldNo := Field.Index;
      FieldOK := true;
      if (Field is TMemoField) or (Field is TBlobField) then
      begin
        PrintCaption := '';
        IsMemo := true;
      end
      else
        IsMemo := false;
    end;
  end
  else
  begin
    Field := nil;
    FieldOK := false;
  end;
end;

procedure TTntQRDBText.Print(OfsX, OfsY: Integer);
begin
  if IsEnabled then
  begin
    if FieldOK then
    begin
      if FDataSet.DefaultFields then
        Field := FDataSet.Fields[FieldNo];
    end
    else
      Field := nil;
    if Assigned(Field) then
    begin
      try
        if (Field is TMemoField) or
          (Field is TBlobField) then
        begin
          Lines.Text := GetAsWideString(Field);
        end
        else if (Mask = '') or (Field is TStringField) then
          if not (Field is TBlobField) then
            PrintCaption := GetWideDisplayText(Field)
          else
            PrintCaption := GetWideText(Field)
        else
        begin
          if (Field is TIntegerField) or
            (Field is TSmallIntField) or
            (Field is TWordField) then
            PrintCaption := FormatFloat(Mask, TIntegerField(Field).Value * 1.0)
          else if (Field is TFloatField) or
            (Field is TCurrencyField) or
            (Field is TBCDField) then
            PrintCaption := FormatFloat(Mask, TFloatField(Field).Value)
          else if (Field is TDateTimeField) or
            (Field is TDateField) or
            (Field is TTimeField) then
            PrintCaption := FormatDateTime(Mask, TDateTimeField(Field).Value);
        end;
      except
        PrintCaption := '';
      end;
    end
    else
      PrintCaption := '';
    inherited Print(OfsX, OfsY);
  end;
end;

procedure TTntQRDBText.SetDataField(Value: string);
begin
  FDataField := Value;
  Caption := Value;
end;

procedure TTntQRDBText.SetDataSet(Value: TDataSet);
begin
  FDataSet := Value;
  if Value <> nil then
    Value.FreeNotification(self);
end;

procedure TTntQRDBText.SetMask(Value: string);
begin

end;

procedure TTntQRDBText.Unprepare;
begin
  inherited;
  Field := nil;
  inherited Unprepare;
  if DataField <> '' then
    SetDataField(DataField) { Reset component caption }
  else
    SetDataField(Name);
end;

function TTntQRDBText.UseRightToLeftAlignment: Boolean;
begin
  Result := QRDBUseRightToLeftAlignment(Self, Field);
end;

{ TTntQRSysData }

constructor TTntQRSysData.Create(AOwner: TComponent);
begin
  inherited;
  FText := '';
  CreateCaption;
end;

procedure TTntQRSysData.CreateCaption;
begin
  case FData of
    qrsTime: Caption := FText + '(' + SqrTime + ')';
    qrsDate: Caption := FText + '(' + SqrDate + ')';
    qrsDateTime: Caption := FText + '(' + SqrDateTime + ')';
    qrsPageNumber: Caption := FText + '(' + SqrPageNum + ')';
    qrsReportTitle: Caption := FText + '(' + SqrReportTitle + ')';
    qrsDetailCount: Caption := FText + '(' + SqrDetailCount + ')';
    qrsDetailNo: Caption := Ftext + '(' + SqrDetailNo + ')';
  end;
  Invalidate;
end;

procedure TTntQRSysData.Print(OfsX, OfsY: Integer);
begin
  case FData of
    qrsTime: Caption := FText + FormatDateTime('t', SysUtils.Time);
    qrsDate: Caption := FText + FormatDateTime('c', SysUtils.Date);
    qrsDateTime: Caption := FText + FormatDateTime('c', Now);
    qrsPageNumber: Caption := FText + IntToStr(ParentReport.PageNumber);
    qrsReportTitle: Caption := FText + ParentReport.ReportTitle;
    qrsDetailCount: if ParentReport is TQuickRep then
        Caption := FText + IntToStr(TQUickRep(ParentReport).RecordCount);
    qrsDetailNo: if ParentReport is TQuickRep then
        Caption := FText + IntToStr(TQuickRep(ParentReport).RecordNumber);
  end;
  inherited Print(OfsX, OfsY);
end;

procedure TTntQRSysData.SetData(Value: TQRSysDataType);
begin
  FData := Value;
  CreateCaption;
end;

procedure TTntQRSysData.SetText(Value: WideString);
begin
  FText := Value;
  CreateCaption;
end;

initialization
  Win9xFarEast := (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and (Win32MajorVersion = 4)
    and SysLocale.FarEast;
  RefCanvas := TCanvas.Create;
  RefCanvas.Handle := CreateCompatibleDC(0);

finalization
  RefCanvas.Free;

end.