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

📄 jvgdigits.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgDigits.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgDigits.pas,v 1.18 2005/02/17 10:21:20 marquardt Exp $

unit JvgDigits;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgUtils, JvgCommClasses;

const
  JvDefaultPassiveColor = TColor($00202020);

type
  TJvgSpecialSymbol = (ssyNone, ssyColon, ssySlash, ssyBackslash);

  {$IFDEF USEJVCL}
  TJvgDigits = class(TJvGraphicControl)
  {$ELSE}
  TJvgDigits = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FValue: Double;
    FDSize: TJvgPointClass;
    FActiveColor: TColor;
    FPassiveColor: TColor;
    FBackgroundColor: TColor;
    FInsertSpecialSymbolAt: Integer;
    FPositions: Word;
    FPenWidth: Word;
    FGap: Word;
    FInterspace: Word;
    FTransparent: Boolean;
    FAlignment: TAlignment;
    FInteriorOffset: Word;
    FPenStyle: TPenStyle;
    FSpecialSymbol: TJvgSpecialSymbol;
    FBevel: TJvgExtBevelOptions;
    FGradient: TJvgGradient;
    FDigitCount: Integer;
    FOldStrWidth: Integer;
    FOldDotPos: Integer;
    FNeedBackgroundPaint: Boolean;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure SetValue(NewValue: Double);
    procedure SetActiveColor(Value: TColor);
    procedure SetPassiveColor(Value: TColor);
    procedure SetBackgroundColor(Value: TColor);
    procedure SetPositions(Value: Word);
    procedure SetPenWidth(Value: Word);
    procedure SetInterspace(Value: Word);
    procedure SetGap(Value: Word);
    procedure SetTransparent(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure SetInteriorOffset(Value: Word);
    procedure SetInsertSpecialSymbolAt(Value: Integer);
    procedure SetPenStyle(Value: TPenStyle);
    procedure SetSpecialSymbol(Value: TJvgSpecialSymbol);
    procedure SetDigitCount(Value: Integer);
    procedure SmthChanged(Sender: TObject);
  public
    procedure Paint; override;
    procedure PaintTo(Canvas: TCanvas);
    property Canvas;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Value: Double read FValue write SetValue;
    property DigitSize: TJvgPointClass read FDSize write FDSize;
    property ActiveColor: TColor read FActiveColor write SetActiveColor default clWhite;
    property PassiveColor: TColor read FPassiveColor write SetPassiveColor default JvDefaultPassiveColor;
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor default clBlack;
    property Positions: Word read FPositions write SetPositions default 0;
    property PenWidth: Word read FPenWidth write SetPenWidth default 1;
    property Gap: Word read FGap write SetGap default 1;
    property Interspace: Word read FInterspace write SetInterspace default 3;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property InteriorOffset: Word read FInteriorOffset write SetInteriorOffset default 0;
    property InsertSpecialSymbolAt: Integer read FInsertSpecialSymbolAt write SetInsertSpecialSymbolAt default -1;
    property PenStyle: TPenStyle read FPenStyle write SetPenStyle default psSolid;
    property SpecialSymbol: TJvgSpecialSymbol read FSpecialSymbol write SetSpecialSymbol default ssyNone;
    property Bevel: TJvgExtBevelOptions read FBevel write FBevel;
    property Gradient: TJvgGradient read FGradient write FGradient;
    property DigitCount: Integer read FDigitCount write SetDigitCount default -1;
    property Width default 160;
    property Height default 28;
    property OnClick;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
  end;

  TJvgGraphDigitsElem =
    (dlT, dlC, dlB, dlTL, dlTR, dlBL, dlBR, dlDOT);
  TJvgGraphDigitsElemSet = set of TJvgGraphDigitsElem;

const
  DigitsSet: array [0..11] of TJvgGraphDigitsElemSet =
   (
    [dlT, dlB, dlTL, dlTR, dlBL, dlBR],      // 0
    [dlTR, dlBR],                            // 1
    [dlT, dlC, dlB, dlTR, dlBL],             // 2
    [dlT, dlC, dlB, dlTR, dlBR],             // 3
    [dlC, dlTL, dlTR, dlBR],                 // 4
    [dlT, dlC, dlB, dlTL, dlBR],             // 5
    [dlT, dlC, dlB, dlTL, dlBL, dlBR],       // 6
    [dlT, dlTR, dlBR],                       // 7
    [dlT, dlC, dlB, dlTL, dlTR, dlBL, dlBR], // 8
    [dlT, dlC, dlB, dlTL, dlTR, dlBR],       // 9
    [],                                      // ' '
    [dlDOT]                                  // ','
   );

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgDigits.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

constructor TJvgDigits.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDSize := TJvgPointClass.Create;
  //...set defaults
  Width := 160;
  Height := 28;
  //  if csDesigning in ComponentState then FValue:=1.1234567890;
  FDSize.X := 10;
  FDSize.Y := 21;
  FDSize.OnChanged := SmthChanged;
  FActiveColor := clWhite;
  FPassiveColor := JvDefaultPassiveColor;
  FBackgroundColor := clBlack;
  FPositions := 0;
  FPenWidth := 1;
  FGap := 1;
  FInterspace := 3;
  FTransparent := False;
  FInteriorOffset := 0;
  FInsertSpecialSymbolAt := -1;
  FDigitCount := -1;
  FPenStyle := psSolid;
  FNeedBackgroundPaint := True;
  Color := FBackgroundColor;
  FAlignment := taCenter;
  FSpecialSymbol := ssyNone;
  FBevel := TJvgExtBevelOptions.Create;
  FBevel.OnChanged := SmthChanged;
  FGradient := TJvgGradient.Create;
  FGradient.OnChanged := SmthChanged;
end;

destructor TJvgDigits.Destroy;
begin
  FDSize.Free;
  FBevel.Free;
  FGradient.Free;
  inherited Destroy;
end;

procedure TJvgDigits.Paint;
begin
  try
    if Canvas.Handle <> 0 then
      PaintTo(Canvas);
  except
  end;
end;

procedure TJvgDigits.PaintTo(Canvas: TCanvas);
var
  Pt, OldPt: TPoint;
  XPos, YPos, D, CenterY, S, I, IWidth: Integer;
  Str, SChar: string;
  R: TRect;
  SPassive: Boolean;
  ClientR: TRect;

  procedure FillBackground;
  begin
    if FTransparent or FGradient.Active then
      Exit;
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := FBackgroundColor;
    Canvas.FillRect(ClientR);
  end;

  function DrawDigit(Pt: TPoint; CActive, CPassive: TColor): Integer;
  label
    deC_L, deB_L, deTL_L, deTR_L, deBL_L, deBR_L, deEND_L;
  begin
    with Canvas do
    begin
      if FInsertSpecialSymbolAt = I then
      begin
        case FSpecialSymbol of
          ssyColon:
            begin
              Pt.X := Pt.X + FInterspace;
              Windows.SetPixel(Handle, Pt.X, Pt.Y + FDSize.Y div 3,
                ColorToRGB(CActive));
              Windows.SetPixel(Handle, Pt.X, Pt.Y + FDSize.Y - FDSize.Y div 3,
                ColorToRGB(CActive));
              Pt.X := Pt.X + FInterspace * 2;
            end;
          ssySlash:
            begin
              Windows.MoveToEx(Handle, Pt.X + FDSize.X, Pt.Y + 1, @OldPt);
              Windows.LineTo(Handle, Pt.X, Pt.Y + FDSize.Y);
              Pt.X := Pt.X + FDSize.X + FInterspace;
            end;
          ssyBackslash:
            begin
              Windows.MoveToEx(Handle, Pt.X, Pt.Y + 1, @OldPt);
              Windows.LineTo(Handle, Pt.X + FDSize.X, Pt.Y + FDSize.Y);
              Pt.X := Pt.X + FDSize.X + FInterspace;
            end;
        end;
      end;
      //OldColonpt.X:=Pt.X;
      if Pen.Width = 1 then
        S := 1
      else
        S := 0;
      R := Rect(Pt.X, Pt.Y, Pt.X + FDSize.X, FDSize.Y + Pt.Y);
      CenterY := R.Top + (FDSize.Y - Pen.Width) div 2;

      SChar := Str[I];
      if SChar = ' ' then
        D := 10
      else
      if (SChar = ',') or (SChar = '.') then
        D := 11
      else
        D := StrToInt(SChar);

      //...Draw Dot
      if Pt.X <= Width then
        if dlDOT in DigitsSet[D] then
        begin
          FOldDotPos := I;
          Windows.SetPixel(Handle, Pt.X, R.Bottom,
            ColorToRGB(CActive));
          Pt.X := Pt.X + FInterspace;
        end
        else
        begin ///...Draw Digit
          if dlT in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deC_L;
          MoveTo(R.Left + FGap, R.Top);
          LineTo(R.Right - FGap + S, R.Top);
        deC_L:
          if dlC in DigitsSet[D] then
            Pen.Color := CActive
          else
          if SPassive then
            Pen.Color := CPassive
          else
            goto deB_L;
          MoveTo(R.Left + FGap, CenterY);
          LineTo(R.Right - FGap + S, CenterY);
        deB_L:
          if dlB in DigitsSet[D] then

⌨️ 快捷键说明

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