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

📄 jvtfgantt.pas

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

  FHScrollBar.Top := ClientHeight - FHScrollBar.Height;
  FHScrollBar.Left := 0;
  FHScrollBar.Width := FVScrollBar.Left - FHScrollBar.Left;

  with FVScrollBar do
    if vsbHorz in VisibleScrollBars then
      Height := FHScrollBar.Top - Top
    else
      Height := Self.ClientHeight - Top;

  with FHScrollBar do
    if vsbVert in VisibleScrollBars then
      Width := FVScrollBar.Left - Left
    else
      Width := Self.ClientWidth - Left;
end;

procedure TJvTFGantt.DrawClientArea;
begin
   // Draw the client area
end;

procedure TJvTFGantt.DrawHeader(ACanvas: TCanvas);
begin
  DrawMajor(ACanvas);
  DrawMinor(ACanvas);
end;

procedure TJvTFGantt.Paint;
begin
  inherited Paint;
  with FPaintBuffer do
  begin
    Width := ClientWidth;
    Height := ClientHeight;

    with Canvas do
    begin
      Brush.Color := Self.Color;
      FillRect(Rect(0, 0, Width, Height));
    end;

    DrawHeader(Canvas);
    DrawClientArea;
  end;
  if Enabled then
    Windows.BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, FPaintBuffer.Canvas.Handle, 0, 0, SRCCOPY)
  else
    Windows.DrawState(Canvas.Handle, 0, nil, FPaintBuffer.Handle, 0, 0, 0, 0, 0, DST_BITMAP or DSS_UNION or
      DSS_DISABLED);

end;

{ Draws SomeBitmap out to the canvas. Use ImageIndex = 0 and NumGlyphsPerBitmap = 1 to draw the entire image,
   or use other values to specify sub-glyphs within the image (for bitmaps that contain several same-sized
   images aligned side-to-side in a single row).

   TargetLeft and TargetTop are the left and top coordinates in the Canvas where you would like this image to appear.
   Use 0 and 0 to place the image in the top left corner.

   CDK: Call this method from an appropriate point in your code (e.g., a "Paint" or "DrawItem" override).

   Examples:

      // Draws entire image:
      DrawCustomGlyph(FCustomGlyphs, 0, 0, 0, 1);

      // Draws last image within FCustomGlyph (which contains four side-to-side images):
      DrawCustomGlyph(FCustomGlyphs, 0, 0, 3, 4);
}

procedure TJvTFGantt.DrawCustomGlyph(SomeBitmap: TBitmap;
  TargetLeft, TargetTop, ImageIndex, NumGlyphsPerBitmap: Integer);
var
  LocalImageWidth: Integer;
  SourceRect, DestRect: TRect;
begin
  with Canvas do
  begin
    with SourceRect do
    begin
      if NumGlyphsPerBitmap = 0 then
        NumGlyphsPerBitmap := 1;
      LocalImageWidth := SomeBitmap.Width div NumGlyphsPerBitmap;
      Left := ImageIndex * LocalImageWidth;
      Top := 0;
      Right := Left + LocalImageWidth;
      Bottom := Top + SomeBitmap.Height;
    end;
    with DestRect do
    begin
      Left := TargetLeft;
      Top := TargetTop;
      Right := Left + LocalImageWidth;
      Bottom := Top + SomeBitmap.Height;
    end;
    CopyRect(DestRect, SomeBitmap.Canvas, SourceRect);
  end;
end;

{ Prepares glyphs for display.
   The following colors in your glyphs will be replaced:

            Yellow with clBtnHighlight
            Silver with clBtnFace
            Gray with clBtnShadow
            White with clWindow
            Red with clWindowText

   CDK: Modify your glyphs so that they conform to the colors above, or alternatively
   modify the colors referenced in the code below.
}

procedure TJvTFGantt.PrepareBitmaps(SomeGlyph: TBitmap; ResourceName: PChar);
var
  LocalBitmap: TBitmap;

  procedure ReplaceColors(SourceBmp, TargetBmp: TBitmap; SourceColor, TargetColor: TColor);
  begin
    TargetBmp.Canvas.Brush.Color := TargetColor;
    TargetBmp.Canvas.BrushCopy(SourceBmp.Canvas.ClipRect, SourceBmp,
      SourceBmp.Canvas.ClipRect, SourceColor);
  end;

begin
  LocalBitmap := TBitmap.Create;
  try
    LocalBitmap.LoadFromResourceName(HInstance, ResourceName);
    SomeGlyph.Width := LocalBitmap.Width;
    SomeGlyph.Height := LocalBitmap.Height;

      { Replace the following colors after loading bitmap:

            clYellow with clBtnHighlight
            clSilver with clBtnFace
            clGray with clBtnShadow
            clWhite with clWindow
            clRed with clWindowText
      }

      { Must call ReplaceColors an odd number of times, to ensure that final image ends up in SomeGlyph.
         As it turns out, we need to make exactly five replacements. Note that each subsequent call to
         ReplaceColors switches the order of parameters LocalBitmap and SomeGlyph. This is because
         we are copying the image back and forth, replacing individual colors with each copy. }

    ReplaceColors(LocalBitmap, SomeGlyph, clYellow, clBtnHighlight);
    ReplaceColors(SomeGlyph, LocalBitmap, clSilver, clBtnFace);
    ReplaceColors(LocalBitmap, SomeGlyph, clGray, clBtnShadow);
    ReplaceColors(SomeGlyph, LocalBitmap, clWhite, clWindow);
    ReplaceColors(LocalBitmap, SomeGlyph, clRed, clWindowText);
  finally
    LocalBitmap.Free;
  end;
end;

procedure TJvTFGantt.PrepareAllBitmaps;
begin
   { CDK: Replace BITMAP_RESOURCE_NAME with the name of your bitmap resource. }
//   PrepareBitmaps(FCustomGlyphs, 'BITMAP_RESOURCE_NAME');
   { CDK: If you have other Glyphs that need loading/preparing, place additional
      calls to PrepareBitmaps here. }
end;

procedure TJvTFGantt.CMSysColorChange(var Msg: TMessage);
begin
  inherited;
  PrepareAllBitmaps;
end;

function TJvTFGantt.ClientCursorPos: TPoint;
begin
  GetCursorPos(Result);
  Result := ScreenToClient(Result);
end;

function TJvTFGantt.ValidMouseAtDesignTime: Boolean;
begin
  Result := False;
end;

procedure TJvTFGantt.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  // True = Allow design-time mouse hits to get through if Alt key is down.
  Msg.Result := Ord(ValidMouseAtDesignTime);
end;

procedure TJvTFGantt.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  AdjustComponentHeightBasedOnFontChange;
end;

procedure TJvTFGantt.AdjustComponentHeightBasedOnFontChange;
begin
{ CDK: Add code to calculate the new height. If this is a composite component
  and you have any edit boxes, the edit box size will have already changed
  based on the new font (providing this method is called from a CM_FontChanged
  message handler).

  For example, your code might look like this:

  LockHeight := False;
  Height := Edit1.Height;
  Button1.Height := Height;
  LockHeight := True;
}
end;

//=== { TJvTFGanttScaleFormat } ==============================================

constructor TJvTFGanttScaleFormat.Create;
begin
  // (rom) added inherited Create
  inherited Create;
  FFont := TFont.Create;
end;

destructor TJvTFGanttScaleFormat.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

function TJvTFGanttScaleFormat.GetFont: TFont;
begin
  Result := FFont;
end;

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

//=== { TJvTFGanttScrollBar } ================================================

constructor TJvTFGanttScrollBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // If we set the csNoDesignVisible flag then visibility at design time
  //  is controlled by the Visible property, which is exactly what we want.
  ControlStyle := ControlStyle + [csNoDesignVisible];
  ParentCtl3D := False;
  Ctl3D := False;
end;

procedure TJvTFGanttScrollBar.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  Msg.Result := 1;
end;

procedure TJvTFGanttScrollBar.CreateWnd;
begin
  inherited CreateWnd;
  UpdateRange;
end;

function TJvTFGanttScrollBar.GetLargeChange: Integer;
begin
  Result := inherited LargeChange;
end;

procedure TJvTFGanttScrollBar.SetLargeChange(Value: Integer);
begin
  inherited LargeChange := Value;
  UpdateRange;
end;

procedure TJvTFGanttScrollBar.UpdateRange;
var
  Info: TScrollInfo;
begin
  FillChar(Info, SizeOf(Info), 0);
  with Info do
  begin
    cbSize := SizeOf(Info);
    fMask := SIF_PAGE;
    nPage := LargeChange;
  end;
  SetScrollInfo(Handle, SB_CTL, Info, True);
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.

⌨️ 快捷键说明

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