⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvprvwrender.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  end;
end;

procedure TJvCustomPreviewRenderer.InternalDoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
begin
  DoAddPage(Sender, PageIndex, Canvas, PageRect, PrintRect, NeedMorePages);
  if Assigned(FOldAddPage) then
    FOldAddPage(Sender, PageIndex, Canvas, PageRect, PrintRect, NeedMorePages);
end;

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

procedure TJvCustomPreviewRenderer.SetPrintPreview(
  const Value: TJvCustomPreviewControl);
begin
  if FPrintPreview <> Value then
  begin
    if FPrintPreview <> nil then
      FPrintPreview.RemoveFreeNotification(Self);
    FPrintPreview := Value;
    if FPrintPreview <> nil then
      FPrintPreview.FreeNotification(Self);
  end;
end;

//=== { TJvPreviewRenderRichEdit } ===========================================

function TJvPreviewRenderRichEdit.CreatePreview(Append: Boolean): Boolean;
begin
  if RichEdit = nil then
    raise EPrintPreviewError.CreateRes(@RsEARichEditComponentMustBeAssignedInC);
  Result := RichEdit.Lines.Count > 0;
  FFinished := not Result;
  FLastChar := 0;
  if Result then
    Result := inherited CreatePreview(Append);
end;

procedure TJvPreviewRenderRichEdit.DoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
var
  Range: TFormatRange;
  OutDC: HDC;
  MaxLen, LogX, LogY, OldMap: Integer;
begin
  FFinished := (RichEdit = nil) or (PrintPreview = nil);
  if not FFinished then
  begin
    FillChar(Range, SizeOf(TFormatRange), 0);
    OutDC := Canvas.Handle;
    Range.hdc := OutDC;
    Range.hdcTarget := OutDC;
    LogX := GetDeviceCaps(OutDC, LOGPIXELSX);
    LogY := GetDeviceCaps(OutDC, LOGPIXELSY);
    if IsRectEmpty(RichEdit.PageRect) then
    begin
      Range.rc.Right := (PrintRect.Right - PrintRect.Left) * cTwipsPerInch div LogX;
      Range.rc.Bottom := (PrintRect.Bottom - PrintRect.Top) * cTwipsPerInch div LogY;
    end
    else
    begin
      Range.rc.Left := RichEdit.PageRect.Left * cTwipsPerInch div LogX;
      Range.rc.Top := RichEdit.PageRect.Top * cTwipsPerInch div LogY;
      Range.rc.Right := RichEdit.PageRect.Right * cTwipsPerInch div LogX;
      Range.rc.Bottom := RichEdit.PageRect.Bottom * cTwipsPerInch div LogY;
    end;
    Range.rcPage := Range.rc;

    MaxLen := RichEdit.GetTextLen;

    Range.chrg.cpMax := -1;

    // ensure the output DC is in text map mode
    OldMap := SetMapMode(Range.hdc, MM_TEXT);
    try
      SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
      Range.chrg.cpMin := FLastChar;
      FLastChar := SendMessage(RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
      FFinished := (FLastChar >= MaxLen) or (FLastChar = -1);
      NeedMorePages := not FFinished;
      SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
    finally
      SetMapMode(OutDC, OldMap);
    end;
  end;
end;

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

procedure TJvPreviewRenderRichEdit.SetRichEdit(
  const Value: TCustomRichEdit);
begin
  if FRichEdit <> Value then
  begin
    if FRichEdit <> nil then
      FRichEdit.RemoveFreeNotification(Self);
    FRichEdit := Value;
    if FRichEdit <> nil then
      FRichEdit.FreeNotification(Self);
  end;
end;

//=== { TJvPreviewRenderJvRichEdit } =========================================

function TJvPreviewRenderJvRichEdit.CreatePreview(Append: Boolean): Boolean;
begin
  if RichEdit = nil then
    raise EPrintPreviewError.CreateRes(@RsEARichEditComponentMustBeAssignedInC);
  Result := RichEdit.Lines.Count > 0;
  FFinished := not Result;
  FLastChar := 0;
  if Result then
    Result := inherited CreatePreview(Append);
end;

procedure TJvPreviewRenderJvRichEdit.DoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
var
  Range: TFormatRange;
  OutDC: HDC;
  ALastChar, MaxLen, LogX, LogY, OldMap: Integer;
  TextLenEx: TGetTextLengthEx;
begin
  FFinished := (RichEdit = nil) or (PrintPreview = nil);
  if not FFinished then
  begin
    FillChar(Range, SizeOf(TFormatRange), 0);
    OutDC := Canvas.Handle;
    Range.hdc := OutDC;
    Range.hdcTarget := OutDC;
    LogX := GetDeviceCaps(OutDC, LOGPIXELSX);
    LogY := GetDeviceCaps(OutDC, LOGPIXELSY);
    if IsRectEmpty(RichEdit.PageRect) then
    begin
      Range.rc.Right := (PrintRect.Right - PrintRect.Left) * cTwipsPerInch div LogX;
      Range.rc.Bottom := (PrintRect.Bottom - PrintRect.Top) * cTwipsPerInch div LogY;
    end
    else
    begin
      Range.rc.Left := RichEdit.PageRect.Left * cTwipsPerInch div LogX;
      Range.rc.Top := RichEdit.PageRect.Top * cTwipsPerInch div LogY;
      Range.rc.Right := RichEdit.PageRect.Right * cTwipsPerInch div LogX;
      Range.rc.Bottom := RichEdit.PageRect.Bottom * cTwipsPerInch div LogY;
    end;
    Range.rcPage := Range.rc;
    if RichEditVersion >= 2 then
    begin
      with TextLenEx do
      begin
        Flags := GTL_DEFAULT;
        codepage := CP_ACP;
      end;
      MaxLen := RichEdit.Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
    end
    else
      MaxLen := RichEdit.GetTextLen;

    Range.chrg.cpMax := -1;

    // ensure the output DC is in text map mode
    OldMap := SetMapMode(Range.hdc, MM_TEXT);
    try
      SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
      Range.chrg.cpMin := FLastChar;
      ALastChar := SendMessage(RichEdit.Handle, EM_FORMATRANGE, 1, Longint(@Range));
      FFinished := (ALastChar >= MaxLen) or (ALastChar = -1) or (ALastChar <= FLastChar);
      FLastChar := ALastChar;
      NeedMorePages := not FFinished;
      if FFinished then
        SendMessage(RichEdit.Handle, EM_FORMATRANGE, 0, 0); // flush buffer
    finally
      SetMapMode(OutDC, OldMap);
    end;
  end;
end;
  
procedure TJvPreviewRenderJvRichEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = RichEdit) then
    RichEdit := nil;
end;

procedure TJvPreviewRenderJvRichEdit.SetRichEdit(const Value: TJvCustomRichEdit);
begin
  if FRichEdit <> Value then
  begin
    if FRichEdit <> nil then
      FRichEdit.RemoveFreeNotification(Self);
    FRichEdit := Value;
    if FRichEdit <> nil then
      FRichEdit.FreeNotification(Self);
  end;
end;

//=== { TJvPreviewRenderStrings } ============================================

constructor TJvPreviewRenderStrings.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStrings := TStringList.Create;
  FFont := TFont.Create;
end;

function TJvPreviewRenderStrings.CreatePreview(Append: Boolean): Boolean;
begin
  Result := Strings.Count > 0;
  FFinished := not Result;
  FCurrentRow := 0;
  if Result then
    Result := inherited CreatePreview(Append);
end;

destructor TJvPreviewRenderStrings.Destroy;
begin
  FStrings.Free;
  FFont.Free;
  inherited Destroy;
end;

procedure TJvPreviewRenderStrings.DoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
var
  i, IncValue: Integer;
  ARect: TRect;
  tm: TTextMetric;
  S: string;
begin
  if not FFinished then
  begin
    Canvas.Font := Font;
    ARect := PrintRect;

    GetTextMetrics(Canvas.Handle, tm);
    IncValue := CanvasMaxTextHeight(Canvas) + tm.tmInternalLeading + tm.tmExternalLeading;
    ARect.Bottom := ARect.Top + IncValue;
    for i := FCurrentRow to Strings.Count - 1 do
    begin
      ARect.Right := PrintRect.Right;
      S := Strings[i];
      IncValue := DrawText(Canvas, PChar(S), Length(S), ARect,
        DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
      if ARect.Right > PrintRect.Right then
      begin
        ARect.Right := PrintRect.Right; // reset and just force a line break in the middle (not fail proof!)
        S := Copy(S, 1, Length(S) div 2) + CrLf +
          Copy(S, Length(S) div 2 + 1, Length(S));
        IncValue := DrawText(Canvas, PChar(S), Length(S), ARect,
          DT_CALCRECT or DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
      end;
      if ARect.Bottom > PrintRect.Bottom then
      begin
        FCurrentRow := i;
        NeedMorePages := True;
        Exit;
      end;
      DrawText(Canvas, PChar(S), Length(S), ARect,
        DT_NOPREFIX or DT_EXPANDTABS or DT_WORDBREAK or DT_LEFT or DT_TOP);
      OffsetRect(ARect, 0, IncValue);
    end;
  end;
  FFinished := True;
end;

procedure TJvPreviewRenderStrings.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

function TJvPreviewRenderStrings.GetStrings: TStrings;
begin
  Result := FStrings;
end;

procedure TJvPreviewRenderStrings.SetStrings(const Value: TStrings);
begin
  FStrings.Assign(Value);
end;

//=== { TJvPreviewRenderControl } ============================================

function TJvPreviewRenderControl.CreatePreview(Append: Boolean): Boolean;
begin
  Result := Control <> nil;
  if Result then
    Result := inherited CreatePreview(Append);
end;

procedure TJvPreviewRenderControl.DoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
var
  Bitmap: TBitmap;
  ARect: TRect;
begin
  NeedMorePages := False;
  Bitmap := TBitmap.Create;
  try
    if Control is TCustomForm then
    begin
      Bitmap.Width := Control.ClientWidth;
      Bitmap.Height := Control.ClientHeight;
    end
    else
    begin
      Bitmap.Width := Control.Width;
      Bitmap.Height := Control.Height;
    end;
    Bitmap.PixelFormat := pf32bit;
    Bitmap.HandleType := bmDIB;
    Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect);
    DrawControl(Bitmap.Canvas, Bitmap.Width, Bitmap.Height);
    if (Bitmap.Width > 0) and (Bitmap.Height > 0) then
    begin
      ARect := CalcDestRect(Bitmap.Width, Bitmap.Height, PrintRect, Stretch,
        Proportional, Center);
      StretchDrawBitmap(Canvas, ARect, Bitmap);
    end;
  finally
    Bitmap.Free;
  end;
end;

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

procedure TJvPreviewRenderControl.SetControl(const Value: TControl);
begin
  if FControl <> Value then
  begin
    if FControl <> nil then
      FControl.RemoveFreeNotification(Self);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -