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

📄 jvtfgantt.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: JvTFGantt.PAS, released on 2003-08-01.

The Initial Developer of the Original Code is Unlimited Intelligence Limited.
Portions created by Unlimited Intelligence Limited are Copyright (C) 1999-2002 Unlimited Intelligence Limited.
All Rights Reserved.

Contributor(s):
Mike Kolter (original code)

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

  .CDK.REGLINK=JvTFGanttComponentsReg.pas
  Created 10/6/2001 6:14:06 PM
  Eagle Software CDK, Version 5.13 Rev. B

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTFGantt.pas,v 1.21 2005/02/17 10:20:55 marquardt Exp $

unit JvTFGantt;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  SysUtils, Classes, Windows, Messages, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls, ExtCtrls,
  JvTFUtils, JvTFManager;

type
  TJvTFGanttScrollBar = class(TScrollBar)
  private
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  protected
    procedure CreateWnd; override;
    function GetLargeChange: Integer; virtual;
    procedure SetLargeChange(Value: Integer); virtual;
    procedure UpdateRange; virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property LargeChange: Integer read GetLargeChange write SetLargeChange default 1;
  end;

  TJvTFGanttScale = (ugsYear, ugsQuarter, ugsMonth, ugsWeek, ugsDay, ugsHour, ugsHalfHour, ugsQuarterHour, ugsMinute);

  TJvTFGanttScaleFormat = class(TPersistent)
  private
    FScale: TJvTFGanttScale;
    FFont: TFont;
    FFormat: string;
    FWidth: Integer;
    function GetFont: TFont;
    procedure SetFont(const Value: TFont);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Format: string read FFormat write FFormat;
    property Font: TFont read GetFont write SetFont;
    property Scale: TJvTFGanttScale read FScale write FScale;
    property Width: Integer read FWidth write FWidth;
  end;

  TJvTFGantt = class(TJvTFControl)
  private
    // property fields
    FMajorScale: TJvTFGanttScaleFormat;
    FMinorScale: TJvTFGanttScaleFormat;
    FHScrollBar: TJvTFGanttScrollBar;
    FVScrollBar: TJvTFGanttScrollBar;
    FVisibleScrollBars: TJvTFVisibleScrollBars;
    FCustomGlyphs: TBitmap;
    // Other class variables
    FPaintBuffer: TBitmap;
    procedure CMSysColorChange(var Msg: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
  protected
    procedure DrawMajor(ACanvas: TCanvas); virtual;
    procedure DrawMinor(ACanvas: TCanvas); virtual;
    procedure SetVisibleScrollBars(Value: TJvTFVisibleScrollBars); virtual;
    function CalcHeaderHeight: Integer;
    procedure AlignScrollBars; virtual;
    function GetMinorScale: TJvTFGanttScaleFormat; virtual;
    procedure SetMinorScale(const Value: TJvTFGanttScaleFormat); virtual;
    function GetMajorScale: TJvTFGanttScaleFormat; virtual;
    procedure SetMajorScale(const Value: TJvTFGanttScaleFormat); virtual;
    procedure DrawClientArea; virtual;
    procedure DrawHeader(ACanvas: TCanvas); virtual;
    procedure Loaded; override;
    procedure Resize; override;
    procedure DrawCustomGlyph(SomeBitmap: TBitmap;
      TargetLeft, TargetTop, ImageIndex, NumGlyphsPerBitmap: Integer); dynamic;
    function ClientCursorPos: TPoint;
    function ValidMouseAtDesignTime: Boolean;
    procedure AdjustComponentHeightBasedOnFontChange; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure PrepareAllBitmaps;
    procedure PrepareBitmaps(SomeGlyph: TBitmap; ResourceName: PChar); dynamic;
    procedure Paint; override;
  published
    property MajorScale: TJvTFGanttScaleFormat read GetMajorScale write SetMajorScale;
    property MinorScale: TJvTFGanttScaleFormat read GetMinorScale write SetMinorScale;
    property VisibleScrollBars: TJvTFVisibleScrollBars read FVisibleScrollBars write SetVisibleScrollBars
      default [vsbHorz, vsbVert];
    property Align;
    property Anchors;
  end;

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

implementation

{$IFDEF USEJVCL}
uses
  JvJVCLUtils, JvResources;
{$ENDIF USEJVCL}

{$IFNDEF USEJVCL}
resourcestring
  RsThisIsTheMajorScale = 'This is the Major Scale';
  RsThisIsTheMinorScale = 'This is the Minor Scale';
{$ENDIF !USEJVCL}

//=== { TJvTFGantt } =========================================================

constructor TJvTFGantt.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPaintBuffer := TBitmap.Create;
  FCustomGlyphs := TBitmap.Create;
  FVisibleScrollBars := [vsbHorz, vsbVert];

  FVScrollBar := TJvTFGanttScrollBar.Create(Self);
  with FVScrollBar do
  begin
    Kind := sbVertical;
    TabStop := False;
    Anchors := [];
    Parent := Self;
    Visible := True;
    // OnScroll := ScrollBarScroll;
  end;

  FHScrollBar := TJvTFGanttScrollBar.Create(Self);
  with FHScrollBar do
  begin
    Kind := sbHorizontal;
    TabStop := False;
    Anchors := [];
    Parent := Self;
    Visible := True;
    // OnScroll := ScrollBarScroll;
  end;

  FMajorScale := TJvTFGanttScaleFormat.Create;
  FMajorScale.Scale := ugsMonth;
  FMajorScale.Format := 'mmmm';
  FMinorScale := TJvTFGanttScaleFormat.Create;
  FMinorScale.Scale := ugsDay;
  FMinorScale.Format := 'dd';

  PrepareAllBitmaps;
end;

destructor TJvTFGantt.Destroy;
begin
  FPaintBuffer.Free;
  FMajorScale.Free;
  FMinorScale.Free;
  FVScrollBar.Free;
  FHScrollBar.Free;
  FCustomGlyphs.Free;
  inherited Destroy;
end;

procedure TJvTFGantt.Loaded;
begin
  inherited Loaded;
  AlignScrollBars;
end;

procedure TJvTFGantt.DrawMajor(ACanvas: TCanvas);
var
  Caption: string;
begin
  ACanvas.Font.Assign(FMajorScale.Font);
  Caption := RsThisIsTheMajorScale;
  ACanvas.TextOut((Width div 2) - (ACanvas.TextWidth(Caption) div 2), 2, Caption);
end;

procedure TJvTFGantt.DrawMinor(ACanvas: TCanvas);
var
  Caption: string;
begin
  ACanvas.Font.Assign(FMinorScale.Font);
  Caption := RsThisIsTheMinorScale;
  ACanvas.TextOut((Width div 2) - (ACanvas.TextWidth(Caption) div 2),
    (CalcHeaderHeight div 2) + 2, Caption);
end;

function TJvTFGantt.CalcHeaderHeight: Integer;
begin
  Result := 0;

  Canvas.Font.Assign(FMajorScale.Font);
  {$IFDEF USEJVCL}
  Result := Result + CanvasMaxTextHeight(Canvas);
  {$ELSE}
  Result := Result + Canvas.TextHeight('Ay');
  {$ENDIF USEJVCL}

  Canvas.Font.Assign(FMinorScale.Font);
  {$IFDEF USEJVCL}
  Result := Result + CanvasMaxTextHeight(Canvas);
  {$ELSE}
  Result := Result + Canvas.TextHeight('Ay');
  {$ENDIF USEJVCL}

  Result := Result + 4;
end;

procedure TJvTFGantt.Resize;
begin
  inherited Resize;
  AlignScrollBars;
end;

procedure TJvTFGantt.SetMajorScale(const Value: TJvTFGanttScaleFormat);
begin
  FMajorScale.Assign(Value);
end;

function TJvTFGantt.GetMajorScale: TJvTFGanttScaleFormat;
begin
  Result := FMajorScale;
end;

procedure TJvTFGantt.SetMinorScale(const Value: TJvTFGanttScaleFormat);
begin
  FMinorScale.Assign(Value);
end;

function TJvTFGantt.GetMinorScale: TJvTFGanttScaleFormat;
begin
  Result := FMinorScale;
end;

procedure TJvTFGantt.SetVisibleScrollBars(Value: TJvTFVisibleScrollBars);
begin
  if Value <> FVisibleScrollBars then
  begin
    FVisibleScrollBars := Value;
    AlignScrollBars;
    FVScrollBar.Visible := vsbVert in FVisibleScrollBars;
    FHScrollBar.Visible := vsbHorz in FVisibleScrollBars;
  end;
end;

procedure TJvTFGantt.AlignScrollBars;
begin
  // DO NOT INVALIDATE GRID IN THIS METHOD
  FVScrollBar.Left := ClientWidth - FVScrollBar.Width;
  FVScrollBar.Top := CalcHeaderHeight;
  FVScrollBar.Height := FHScrollBar.Top - FVScrollBar.Top;

⌨️ 快捷键说明

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