📄 jvprvwdoc.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    (Inner.Right > Outer.Left) and
    (Inner.Bottom > Outer.Top);
end;

// use our own EnsureRange since D5 doesn't have it

function EnsureRange(const AValue, AMin, AMax: Integer): Integer;
begin
  Result := AValue;
  Assert(AMin <= AMax);
  if Result < AMin then
    Result := AMin;
  if Result > AMax then
    Result := AMax;
end;

//=== { TJvPreviewPageOptions } ==============================================

constructor TJvPreviewPageOptions.Create;
begin
  inherited Create;
  FShadow := TJvPageShadow.Create;
  FShadow.OnChange := DoShadowChange;
  FCols := 1;
  FRows := 1;
  FScale := 100;
  FScaleMode := smFullPage;
  FColor := clWhite;
  FVertSpacing := 8;
  FHorzSpacing := 8;
  FDrawMargins := True;
end;

destructor TJvPreviewPageOptions.Destroy;
begin
  FShadow.Free;
  inherited Destroy;
end;

procedure TJvPreviewPageOptions.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvPreviewPageOptions.DoShadowChange(Sender: TObject);
begin
  Change;
end;

function TJvPreviewPageOptions.GetCols: Cardinal;
begin
  Result := Max(FCols, 1);
end;

function TJvPreviewPageOptions.GetHorzSpacing: Cardinal;
begin
  Result := Max(FHorzSpacing, Abs(Shadow.Offset));
end;

function TJvPreviewPageOptions.GetRows: Cardinal;
begin
  Result := Max(FRows, 1);
end;

function TJvPreviewPageOptions.GetVertSpacing: Cardinal;
begin
  Result := Max(FVertSpacing, Abs(Shadow.Offset));
end;

procedure TJvPreviewPageOptions.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetCols(const Value: Cardinal);
begin
  if FCols <> Value then
  begin
    FCols := Value;
    if FCols < 1 then
      FCols := 1;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetDrawMargins(const Value: Boolean);
begin
  if FDrawMargins <> Value then
  begin
    FDrawMargins := Value;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetHorzSpacing(const Value: Cardinal);
begin
  if FHorzSpacing <> Value then
  begin
    FHorzSpacing := Value;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetRows(const Value: Cardinal);
begin
  if FRows <> Value then
  begin
    FRows := Value;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetShadow(const Value: TJvPageShadow);
begin
  FShadow.Assign(Value);
end;

procedure TJvPreviewPageOptions.SetVertSpacing(const Value: Cardinal);
begin
  if FVertSpacing <> Value then
  begin
    FVertSpacing := Value;
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetScale(const Value: Cardinal);
begin
  if FScale <> Value then
  begin
    FScale := Max(Value, 1);
    Change;
  end;
end;

procedure TJvPreviewPageOptions.SetScaleMode(
  const Value: TJvPreviewScaleMode);
begin
  if FScaleMode <> Value then
  begin
    FScaleMode := Value;
    ScaleModeChange;
  end;
end;

procedure TJvPreviewPageOptions.ScaleModeChange;
begin
  if Assigned(FOnScaleModeChange) then
    FOnScaleModeChange(Self)
  else
    Change;
end;

//=== { TJvPageShadow } ======================================================

constructor TJvPageShadow.Create;
begin
  inherited Create;
  FColor := clBlack;
  FOffset := 4;
end;

procedure TJvPageShadow.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvPageShadow.SetColor(const Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Change;
  end;
end;

procedure TJvPageShadow.SetOffset(const Value: Integer);
begin
  if FOffset <> Value then
  begin
    FOffset := Value;
    Change;
  end;
end;

//=== { TJvDeviceInfo } ======================================================

constructor TJvDeviceInfo.Create;
begin
  inherited Create;
  DefaultDeviceInfo;
end;

destructor TJvDeviceInfo.Destroy;
begin
  if FScreenDC <> 0 then
    ReleaseDC(HWND_DESKTOP, FScreenDC);
  inherited Destroy;
end;

procedure TJvDeviceInfo.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TJvDeviceInfo.GetScreenDC: Longword;
begin
  if FScreenDC <> 0 then
    ReleaseDC(HWND_DESKTOP, FScreenDC);
  FScreenDC := GetDC(HWND_DESKTOP);
  Result := FScreenDC;
end;

function TJvDeviceInfo.InchToXPx(Inch: Single): Integer;
begin
  Result := Round(Inch * LogPixelsY);
end;

function TJvDeviceInfo.InchToYPx(Inch: Single): Integer;
begin
  Result := Round(Inch * LogPixelsX);
end;

function TJvDeviceInfo.MMToXPx(MM: Single): Integer;
begin
  Result := InchToXPx(MM / 25.4);
end;

function TJvDeviceInfo.MMToYPx(MM: Single): Integer;
begin
  Result := InchToYPx(MM / 25.4);
end;

procedure TJvDeviceInfo.SetLogPixelsY(const Value: Cardinal);
begin
  if FLogPixelsY <> Value then
  begin
    FLogPixelsY := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetLogPixesX(const Value: Cardinal);
begin
  if FLogPixelsX <> Value then
  begin
    FLogPixelsX := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetOffsetBottom(const Value: Cardinal);
begin
  if FOffsetBottom <> Value then
  begin
    FOffsetBottom := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetOffsetRight(const Value: Cardinal);
begin
  if FOffsetRight <> Value then
  begin
    FOffsetRight := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetOffsetX(const Value: Cardinal);
begin
  if FOffsetLeft <> Value then
  begin
    FOffsetLeft := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetOffsetY(const Value: Cardinal);
begin
  if FOffsetTop <> Value then
  begin
    FOffsetTop := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetPageHeight(const Value: Cardinal);
begin
  if FPageHeight <> Value then
  begin
    FPageHeight := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetPageWidth(const Value: Cardinal);
begin
  if FPageWidth <> Value then
  begin
    FPageWidth := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetPhysicalHeight(const Value: Cardinal);
begin
  if FPhysicalHeight <> Value then
  begin
    FPhysicalHeight := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetPhysicalWidth(const Value: Cardinal);
begin
  if FPhysicalWidth <> Value then
  begin
    FPhysicalWidth := Value;
    Change;
  end;
end;

procedure TJvDeviceInfo.SetReferenceHandle(const Value: Longword);
begin
  FReferenceHandle := Value;
  if FReferenceHandle = 0 then
  begin
    DefaultDeviceInfo;
    Exit;
  end;
  FLogPixelsX := GetDeviceCaps(FReferenceHandle, Windows.LOGPIXELSX);
  FLogPixelsY := GetDeviceCaps(FReferenceHandle, Windows.LOGPIXELSY);
  FPageWidth := GetDeviceCaps(FReferenceHandle, HORZRES);
  FPageHeight := GetDeviceCaps(FReferenceHandle, VERTRES);
  FPhysicalWidth := Max(GetDeviceCaps(FReferenceHandle, Windows.PHYSICALWIDTH), FPageWidth);
  FPhysicalHeight := Max(GetDeviceCaps(FReferenceHandle, Windows.PHYSICALHEIGHT), FPageHeight);

  FOffsetLeft := GetDeviceCaps(FReferenceHandle, PHYSICALOFFSETX);
  FOffsetTop := GetDeviceCaps(FReferenceHandle, PHYSICALOFFSETY);
  if FPhysicalWidth <> FPageWidth then
    FOffsetRight := Max(FPhysicalWidth - FPageWidth - FOffsetLeft, 0)
  else
    FOffsetRight := FOffsetLeft;
  if FPhysicalHeight <> FPageHeight then
    FOffsetBottom := Max(FPhysicalHeight - FPageHeight - FOffsetTop, 0)
  else
    FOffsetBottom := FOffsetTop;
  Change;
end;

procedure TJvDeviceInfo.DefaultDeviceInfo;
begin
  // default sizes using my current printer (HP DeskJet 690C)
  FReferenceHandle := 0;
  FLogPixelsX := 300;
  FLogPixelsY := 300;
  FPhysicalWidth := 2480;
  FPhysicalHeight := 3507;
  FPageWidth := 2400;
  FPageHeight := 3281;

  FOffsetLeft := 40;
  FOffsetTop := 40;
  FOffsetRight := 40;
  FOffsetBottom := 40;
  Change;
end;

function TJvDeviceInfo.XPxToInch(Pixels: Integer): Single;
begin
  Result := Pixels / LogPixelsX;
end;

function TJvDeviceInfo.XPxToMM(Pixels: Integer): Single;
begin
  Result := XPxToInch(Pixels) / 25.4;
end;

function TJvDeviceInfo.YPxToInch(Pixels: Integer): Single;
begin
  Result := Pixels / LogPixelsY;
end;

function TJvDeviceInfo.YPxToMM(Pixels: Integer): Single;
begin
  Result := YPxToInch(Pixels) / 25.4;
end;

//=== { TJvCustomPreviewControl } ============================================

constructor TJvCustomPreviewControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSelectedPage := -1;
  FPages := TList.Create;
  FPages.Capacity := 64;
  FBuffer := TBitmap.Create;

  FOptions := TJvPreviewPageOptions.Create;
  FOptions.OnChange := DoOptionsChange;
  FOptions.OnScaleModeChange := DoScaleModeChange;

  FDeviceInfo := TJvDeviceInfo.Create;
  FDeviceInfo.OnChange := DoDeviceInfoChange;

  FSelection := TJvPreviewSelection.Create;
  FSelection.OnChange := DoOptionsChange;

  Color := clAppWorkSpace;
  ControlStyle := [csOpaque, csAcceptsControls, csCaptureMouse, csClickEvents, csDoubleClicks];
  IncludeThemeStyle(Self, [csNeedsBorderPaint]);
  Width := 150;
  Height := 250;
  FBorderStyle := bsSingle;
  FScrollBars := ssBoth;
  FHideScrollBars := False;
  TabStop := True;
end;

destructor TJvCustomPreviewControl.Destroy;
begin
  Clear;
  FDeviceInfo.Free;
  FSelection.Free;
  FOptions.Free;
  FPages.Free;
  FBuffer.Free;
  inherited Destroy;
end;

function TJvCustomPreviewControl.Add: TMetafile;
begin
  repeat
    Result := TMetafile.Create;
    Result.Width := DeviceInfo.PhysicalWidth;
    Result.Height := DeviceInfo.PhysicalHeight;
    // keep adding pages until user says stop
  until not DoAddPage(Result, FPages.Add(Result));
  Change;
end;

procedure TJvCustomPreviewControl.CalcScrollRange;
var
  SI: TScrollInfo;
begin
  // HORIZONTAL SCROLLBAR
  FillChar(SI, SizeOf(TScrollInfo), 0);
  SI.cbSize := SizeOf(TScrollInfo);
  SI.fMask := SIF_ALL;
  if not HideScrollBars then
    Inc(SI.fMask, SIF_DISABLENOSCROLL);
  GetScrollInfo(Handle, SB_HORZ, SI);

  SI.nMax := FMaxWidth - ClientWidth;
  SI.nPage := 0;
  ShowScrollBar(Handle, SB_HORZ, not HideScrollBars and (ScrollBars in [ssHorizontal, ssBoth]));
  SetScrollInfo(Handle, SB_HORZ, SI, True);
  // update scroll pos if it has changed
  GetScrollInfo(Handle, SB_HORZ, SI);
  if SI.nPos <> FScrollPos.X then
  begin
    ScrollBy(-FScrollPos.X + SI.nPos, 0);
    FScrollPos.X := SI.nPos;
  end;

  // VERTICAL SCROLLBAR
  FillChar(SI, SizeOf(TScrollInfo), 0);
  SI.cbSize := SizeOf(TScrollInfo);
  SI.fMask := SIF_ALL;
  if not HideScrollBars then
    Inc(SI.fMask, SIF_DISABLENOSCROLL);
  GetScrollInfo(Handle, SB_VERT, SI);
  if PageCount = 0 then
  begin
    SI.nMax := 0;
    SI.nPage := 0;
  end
  else
  begin
    SI.nMax := FMaxHeight - ClientHeight;
    SI.nPage := 0; // FMaxHeight div TotalRows;
  end;
  ShowScrollBar(Handle, SB_VERT, not HideScrollBars and (ScrollBars in [ssVertical, ssBoth]));
  SetScrollInfo(Handle, SB_VERT, SI, True);
  // update scroll pos if it has changed
  GetScrollInfo(Handle, SB_VERT, SI);
  if SI.nPos <> FScrollPos.Y then
  begin
    ScrollBy(0, -FScrollPos.Y + SI.nPos);
    FScrollPos.Y := SI.nPos;
⌨️ 快捷键说明

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