jvprvwrender.pas

East make Tray Icon in delphi

    FControl := Value;
    if FControl <> nil then
      FControl.FreeNotification(Self);
  end;
end;

procedure TJvPreviewRenderControl.DrawControl(ACanvas: TCanvas; AWidth, AHeight: Integer);
var
  SaveIndex: Integer;
  ADC: HDC;
begin
  ACanvas.Lock;
  try
    ADC := ACanvas.Handle;
    if Control is TWinControl then
      TWinControl(Control).PaintTo(ADC, 0, 0)
    else
    if Control <> nil then
    begin
      SaveIndex := SaveDC(ADC);
      try
        Control.ControlState := Control.ControlState + [csPaintCopy];
        MoveWindowOrg(ADC, 0, 0);
        IntersectClipRect(ADC, 0, 0, Control.Width, Control.Height);
        Control.Perform(WM_ERASEBKGND, ADC, 0);
        Control.Perform(WM_PAINT, ADC, 0);
      finally
        RestoreDC(ADC, SaveIndex);
        Control.ControlState := Control.ControlState - [csPaintCopy];
      end;
    end
  finally
    ACanvas.Unlock;
  end;
end;

constructor TJvPreviewRenderControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FStretch := True;
  FProportional := True;
  FCenter := True;
end;

//=== { TJvPreviewGraphicItems } =============================================

function TJvPreviewGraphicItems.Add: TJvPreviewGraphicItem;
begin
  Result := TJvPreviewGraphicItem(inherited Add);
end;

constructor TJvPreviewGraphicItems.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvPreviewGraphicItem);
end;

function TJvPreviewGraphicItems.GetItems(
  Index: Integer): TJvPreviewGraphicItem;
begin
  Result := TJvPreviewGraphicItem(inherited Items[Index]);
end;

procedure TJvPreviewGraphicItems.SetItems(Index: Integer;
  const Value: TJvPreviewGraphicItem);
begin
  inherited Items[Index] := Value;
end;

//=== { TJvPreviewGraphicItem } ==============================================

constructor TJvPreviewGraphicItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FPicture := TPicture.Create;
  FCenter := True;
  FProportional := True;
  FStretch := True;
end;

function TJvPreviewGraphicItem.DestRect(RefRect: TRect; DestDC: HDC): TRect;
// var Points: TPoint;
begin
  UpdateGraphic;
  Result := CalcDestRect(Picture.Width,Picture.Height, RefRect, Stretch, Proportional, Center);
end;

destructor TJvPreviewGraphicItem.Destroy;
begin
  FPicture.Free;
  inherited Destroy;
end;

procedure TJvPreviewGraphicItem.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TJvPreviewGraphicItem.UpdateGraphic;
var
  G: TGraphic;
begin
  if (Picture.Width > 0) and (Picture.Height > 0) then
  begin
    G := Picture.Graphic;
    if (G <> nil) and not ((G is TMetaFile) or (G is TIcon)) then
      G.Transparent := Transparent;
  end;
end;

//=== { TJvPreviewRenderGraphics } ===========================================

constructor TJvPreviewRenderGraphics.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FImages := TJvPreviewGraphicItems.Create(Self);
end;

function TJvPreviewRenderGraphics.CreatePreview(Append: Boolean): Boolean;
begin
  Result := FImages.Count > 0;
  if Result then
    Result := inherited CreatePreview(Append);
end;

destructor TJvPreviewRenderGraphics.Destroy;
begin
  FImages.Free;
  inherited Destroy;
end;

procedure TJvPreviewRenderGraphics.DoAddPage(Sender: TObject;
  PageIndex: Integer; Canvas: TCanvas; PageRect, PrintRect: TRect;
  var NeedMorePages: Boolean);
var
  Img: TImageList;
begin
  with Images[PageIndex] do
    if (PageIndex < Images.Count) and (Picture.Height > 0) and (Picture.Width > 0) and
      (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
    begin
      if Picture.Graphic is TIcon then
      begin
        Img := TImageList.CreateSize(Picture.Width, Picture.Height);
        try
          Img.AddIcon(Picture.Icon);
          Img.GetBitmap(0, Picture.Bitmap);
        finally
          Img.Free;
        end;
      end;
      if Picture.Graphic is TBitmap then
        StretchDrawBitmap(Canvas, DestRect(PrintRect,Canvas.Handle), Picture.Bitmap)
      else
        Canvas.StretchDraw(DestRect(PrintRect,Canvas.Handle), Picture.Graphic);
    end;
  NeedMorePages := PageIndex < Images.Count - 1;
end;

function TJvPreviewRenderGraphics.GetPPX(ADC: HDC): Integer;
begin
  Result := GetDeviceCaps(ADC, LOGPIXELSX);
end;

function TJvPreviewRenderGraphics.GetPPY(ADC: HDC): Integer;
begin
  Result := GetDeviceCaps(ADC, LOGPIXELSY);
end;

procedure TJvPreviewRenderGraphics.SetImages(const Value: TJvPreviewGraphicItems);
begin
  FImages.Assign(Value);
end;

//=== { TJvPreviewPrinter } ==================================================

procedure TJvPreviewPrinter.Abort;
begin
  CheckPrinter;
  if GetPrinting then
    FPrinter.Abort;
  if Assigned(FOnAbort) then
    FOnAbort(Self);
end;

procedure TJvPreviewPrinter.Assign(Source: TPersistent);
begin
  CheckActive;
  if Source is TJvPreviewPrinter then
  begin
    Collate := TJvPreviewPrinter(Source).Collate;
    Copies := TJvPreviewPrinter(Source).Copies;
    FromPage := TJvPreviewPrinter(Source).FromPage;
    Options := TJvPreviewPrinter(Source).Options;
    PrintRange := TJvPreviewPrinter(Source).PrintRange;
    ToPage := TJvPreviewPrinter(Source).ToPage;
    Title := TJvPreviewPrinter(Source).Title;
  end
  else
  if Source is TPrintDialog then
  begin
    Collate := TPrintDialog(Source).Collate;
    Copies := TPrintDialog(Source).Copies;
    FromPage := TPrintDialog(Source).FromPage;
    Options := TPrintDialog(Source).Options;
    PrintRange := TPrintDialog(Source).PrintRange;
    ToPage := TPrintDialog(Source).ToPage;
  end
  else
    inherited Assign(Source);
end;

procedure TJvPreviewPrinter.BeginDoc;
begin
  CheckPrinter;
  FPrinter.BeginDoc;
  if Assigned(FOnBeginDoc) then
    FOnBeginDoc(Self);
  FPageIndex := 0;
end;

procedure TJvPreviewPrinter.CheckActive;
begin
  if (Printer <> nil) and GetPrinting then
    raise EPrintPreviewError.CreateRes(@RsECannotPerfromThisOperationWhilePrin);
end;

procedure TJvPreviewPrinter.CheckPrinter;
begin
  if Printer = nil then
    raise EPrintPreviewError.CreateRes(@RsEPrinterNotAssigned);
end;

procedure TJvPreviewPrinter.EndDoc;
begin
  CheckPrinter;
  FPrinter.EndDoc;
  if Assigned(FOnEndDoc) then
    FOnEndDoc(Self);
end;

function TJvPreviewPrinter.GetAborted: Boolean;
begin
  CheckPrinter;
  Result := FPrinter.Aborted;
end;

function TJvPreviewPrinter.GetCanvas: TCanvas;
begin
  CheckPrinter;
  Result := FPrinter.Canvas;
end;

function TJvPreviewPrinter.GetPageHeight: Integer;
begin
  CheckPrinter;
  Result := FPrinter.PageHeight;
end;

function TJvPreviewPrinter.GetPageWidth: Integer;
begin
  CheckPrinter;
  Result := FPrinter.PageWidth;
end;

function TJvPreviewPrinter.GetPrinting: Boolean;
begin
  CheckPrinter;
  Result := FPrinter.Printing;
end;

function TJvPreviewPrinter.GetTitle: string;
begin
  CheckPrinter;
  Result := FPrinter.Title;
end;

procedure TJvPreviewPrinter.NewPage;
begin
  CheckPrinter;
  FPrinter.NewPage;
  if Assigned(FOnNewPage) then
    FOnNewPage(Self, FPageIndex);
  Inc(FPageIndex);
end;

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

procedure TJvPreviewPrinter.Print;
var
  AMin, AMax: Integer;
begin
  if PrintPreview = nil then
    raise EPrintPreviewError.CreateRes(@RsENoPrintPreviewAssigned);
  if PrintRange = prAllPages then
  begin
    AMin := 0;
    AMax := PrintPreview.PageCount - 1;
  end
  else
  begin
    AMin := FromPage - 1;
    AMax := ToPage - 1;
  end;
  PrintPreview.PrintRange(Self, AMin, AMax, Copies, Collate);
end;

procedure TJvPreviewPrinter.SetNumCopies(const Value: Integer);
begin
  FCopies := Value;
  if FCopies < 1 then
    FCopies := 1;
end;

procedure TJvPreviewPrinter.SetPrinter(const Value: TPrinter);
begin
  CheckActive;
  FPrinter := Value;
end;

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

procedure TJvPreviewPrinter.SetTitle(const Value: string);
begin
  CheckPrinter;
  FPrinter.Title := Value;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.