jvqnetscapesplitter.pas

East make Tray Icon in delphi

      Y := Top + ((Bottom - Top - ArrowSize) div 2) + 1;
      for I := Y to Y + ArrowSize - 1 do
      begin
        for J := X to X + Q - 1 do
          ACanvas.Pixels[J, I] := Color;
        Inc(X);
        Dec(Q, 2);
      end;
    end;
  end;
end;

procedure TJvCustomNetscapeSplitter.FindControl;
var
  P: TPoint;
  I: Integer;
  R: TRect;
begin
  if Parent = nil then
    Exit;
  FControl := nil;
  P := Point(Left, Top);
  case Align of
    alLeft:
      Dec(P.X);
    alRight:
      Inc(P.X, Width);
    alTop:
      Dec(P.Y);
    alBottom:
      Inc(P.Y, Height);
  else
    Exit;
  end;
  for I := 0 to Parent.ControlCount - 1 do
  begin
    FControl := Parent.Controls[I];
    if FControl.Visible and FControl.Enabled then
    begin
      R := FControl.BoundsRect;
      if (R.Right - R.Left) = 0 then
        Dec(R.Left);
      if (R.Bottom - R.Top) = 0 then
        Dec(R.Top);
      if PtInRect(R, P) then
        Exit;
    end;
  end;
  FControl := nil;
end;

function TJvCustomNetscapeSplitter.GetAlign: TAlign;
begin
  Result := inherited Align;
end;

function TJvCustomNetscapeSplitter.GetButtonRect: TRect;
var
  BW: Integer;
begin
  if ButtonStyle = bsWindows then
  begin
    if Align in [alLeft, alRight] then
      BW := (ClientRect.Right - ClientRect.Left) * VisibleWinButtons
    else
      BW := (ClientRect.Bottom - ClientRect.Top) * VisibleWinButtons;
    if BW < 1 then
      SetRectEmpty(Result)
    else
    begin
      if Align in [alLeft, alRight] then
        Result := Rect(0, 0, ClientRect.Right - ClientRect.Left,
          BW - VisibleWinButtons)
      else
        Result := Rect(ClientRect.Right - BW + VisibleWinButtons, 0,
          ClientRect.Right, ClientRect.Bottom - ClientRect.Top);
      InflateRect(Result, -1, -1);
    end;
  end
  else
  begin
    // Calc the rectangle the button goes in
    if ButtonWidthKind = btwPercentage then
    begin
      if Align in [alLeft, alRight] then
        BW := ClientRect.Bottom - ClientRect.Top
      else
        BW := ClientRect.Right - ClientRect.Left;
      BW := MulDiv(BW, FButtonWidth, 100);
    end
    else
      BW := FButtonWidth;
    if BW < 1 then
      SetRectEmpty(Result)
    else
    begin
      Result := ClientRect;
      if Align in [alLeft, alRight] then
      begin
        Result.Top := (ClientRect.Bottom - ClientRect.Top - BW) div 2;
        Result.Bottom := Result.Top + BW;
        InflateRect(Result, -1, 0);
      end
      else
      begin
        Result.Left := (ClientRect.Right - ClientRect.Left - BW) div 2;
        Result.Right := Result.Left + BW;
        InflateRect(Result, 0, -1);
      end;
    end;
  end;
  if not IsRectEmpty(Result) then
  begin
    if Result.Top < 1 then
      Result.Top := 1;
    if Result.Left < 1 then
      Result.Left := 1;
    if Result.Bottom >= ClientRect.Bottom then
      Result.Bottom := ClientRect.Bottom - 1;
    if Result.Right >= ClientRect.Right then
      Result.Right := ClientRect.Right - 1;
    // Make smaller if it's beveled
    if Beveled then
      if Align in [alLeft, alRight] then
        InflateRect(Result, -3, 0)
      else
        InflateRect(Result, 0, -3);
  end;
  FLastKnownButtonRect := Result;
end;

function TJvCustomNetscapeSplitter.GrabBarColor: TColor;
var
  BeginRGB: array [0..2] of Byte;
  RGBDifference: array [0..2] of Integer;
  R, G, B: Byte;
  BeginColor, EndColor: TColor;
  NumberOfColors: Integer;
begin
  //Need to figure out how many colors available at runtime
  NumberOfColors := 256;

  BeginColor := clActiveCaption;
  EndColor := clBtnFace;

  BeginRGB[0] := GetRValue(ColorToRGB(BeginColor));
  BeginRGB[1] := GetGValue(ColorToRGB(BeginColor));
  BeginRGB[2] := GetBValue(ColorToRGB(BeginColor));

  RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGB[0];
  RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGB[1];
  RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGB[2];

  R := BeginRGB[0] + MulDiv(180, RGBDifference[0], NumberOfColors - 1);
  G := BeginRGB[1] + MulDiv(180, RGBDifference[1], NumberOfColors - 1);
  B := BeginRGB[2] + MulDiv(180, RGBDifference[2], NumberOfColors - 1);

  Result := RGB(R, G, B);
end;

procedure TJvCustomNetscapeSplitter.Loaded;
begin
  inherited Loaded;
  if FRestorePos = -1 then
  begin
    FindControl;
    if FControl <> nil then
      case Align of
        alLeft, alRight:
          FRestorePos := FControl.Width;
        alTop, alBottom:
          FRestorePos := FControl.Height;
      end;
  end;
end;

procedure TJvCustomNetscapeSplitter.LoadOtherProperties(Reader: TReader);
begin
  RestorePos := Reader.ReadInteger;
end;

procedure TJvCustomNetscapeSplitter.PaintButton(Highlight: Boolean);
const
  TEXTURE_SIZE = 3;
var
  BtnRect: TRect;
  CaptionBtnRect: TRect;
  BW: Integer;
  TextureBmp: TBitmap;
  X, Y: Integer;
  RW, RH: Integer;
  OffscreenBmp: TBitmap;
  WinButton: array [0..2] of TJvWindowsButton;
  B: TJvWindowsButton;
  BtnFlag: UINT;
begin
  if (not FShowButton) or (not Enabled) or (GetParentForm(Self) = nil) then
    Exit;

  if FAutoHighlightColor then
    FButtonHighlightColor := GrabBarColor;

  BtnRect := ButtonRect; // So we don't repeatedly call GetButtonRect
  if IsRectEmpty(BtnRect) then
    Exit; // nothing to draw

  OffscreenBmp := TBitmap.Create;
  try
    OffsetRect(BtnRect, -BtnRect.Left, -BtnRect.Top);
    OffscreenBmp.Width := BtnRect.Right;
    OffscreenBmp.Height := BtnRect.Bottom;

    if ButtonStyle = bsWindows then
    begin
      OffscreenBmp.Canvas.Brush.Color := Color;
      OffscreenBmp.Canvas.FillRect(BtnRect);
      if Align in [alLeft, alRight] then
        BW := BtnRect.Right
      else
        BW := BtnRect.Bottom;
      FillChar(WinButton, SizeOf(WinButton), 0);
      X := 0;
      if Align in [alLeft, alRight] then
      begin
        for B := High(TJvWindowsButton) downto Low(TJvWindowsButton) do
          if B in WindowsButtons then
          begin
            WinButton[X] := B;
            Inc(X);
          end;
      end
      else
      begin
        for B := Low(TJvWindowsButton) to High(TJvWindowsButton) do
          if B in WindowsButtons then
          begin
            WinButton[X] := B;
            Inc(X);
          end;
      end;
      for X := 0 to VisibleWinButtons - 1 do
      begin
        if Align in [alLeft, alRight] then
          CaptionBtnRect := Bounds(0, X * BW, BW, BW)
        else
          CaptionBtnRect := Bounds(X * BW, 0, BW, BW);
        BtnFlag := 0;
        case WinButton[X] of
          wbMin:
            if Minimized then
              BtnFlag := DFCS_CAPTIONRESTORE
            else
              BtnFlag := DFCS_CAPTIONMIN;
          wbMax:
            if Maximized then
              BtnFlag := DFCS_CAPTIONRESTORE
            else
              BtnFlag := DFCS_CAPTIONMAX;
          wbClose:
            BtnFlag := DFCS_CAPTIONCLOSE;
        end;
        DrawFrameControl(OffscreenBmp.Canvas.Handle,
          CaptionBtnRect, DFC_CAPTION, BtnFlag);
      end;
    end
    else
    begin
      // Draw basic button
      OffscreenBmp.Canvas.Brush.Color := clGray;  
      FrameRect(OffscreenBmp.Canvas, BtnRect); 
      InflateRect(BtnRect, -1, -1);

      OffscreenBmp.Canvas.Pen.Color := clWhite;
      with BtnRect, OffscreenBmp.Canvas do
      begin
        // This is not going to work with the STB bug.  Have to find workaround.
        MoveTo(Left, Bottom - 1);
        LineTo(Left, Top);
        LineTo(Right, Top);
      end;
      Inc(BtnRect.Left);
      Inc(BtnRect.Top);

      if Highlight then
        OffscreenBmp.Canvas.Brush.Color := ButtonHighlightColor
      else
        OffscreenBmp.Canvas.Brush.Color := ButtonColor;
      OffscreenBmp.Canvas.FillRect(BtnRect);
      FIsHighlighted := Highlight;
      Dec(BtnRect.Right);
      Dec(BtnRect.Bottom);

      // Draw the insides of the button
      with BtnRect do
      begin
        // Draw the arrows
        if Align in [alLeft, alRight] then
        begin
          InflateRect(BtnRect, 0, -4);
          BW := BtnRect.Right - BtnRect.Left;
          DrawArrow(OffscreenBmp.Canvas, BtnRect, 1, BW, ArrowColor);
          BW := DrawArrow(OffscreenBmp.Canvas, BtnRect, -1, BW, ArrowColor);
          InflateRect(BtnRect, 0, -(BW + 4));
        end
        else
        begin
          InflateRect(BtnRect, -4, 0);
          BW := BtnRect.Bottom - BtnRect.Top;
          DrawArrow(OffscreenBmp.Canvas, BtnRect, 1, BW, ArrowColor);
          BW := DrawArrow(OffscreenBmp.Canvas, BtnRect, -1, BW, ArrowColor);
          InflateRect(BtnRect, -(BW + 4), 0);
        end;

        // Draw the texture
        // Note: This is so complex because I'm trying to make as much like the
        //       Netscape splitter as possible.  They use a 3x3 texture pattern, and
        //       that's harder to tile.  If the had used an 8x8 (or smaller
        //       divisibly, i.e. 2x2 or 4x4), I could have used Brush.Bitmap and
        //       FillRect and they whole thing would have been about half the size,
        //       twice as fast, and 1/10th as complex.
        RW := BtnRect.Right - BtnRect.Left;
        RH := BtnRect.Bottom - BtnRect.Top;
        if (RW >= TEXTURE_SIZE) and (RH >= TEXTURE_SIZE) then
        begin
          TextureBmp := TBitmap.Create;
          try
            with TextureBmp do
            begin
              Width := RW;
              Height := RH;
              // Draw first square
              Canvas.Brush.Color := OffscreenBmp.Canvas.Brush.Color;
              Canvas.FillRect(Rect(0, 0, RW + 1, RH + 1));
              Canvas.Pixels[1, 1] := TextureColor1;
              Canvas.Pixels[2, 2] := TextureColor2;

              // Tile first square all the way across
              for X := 1 to ((RW div TEXTURE_SIZE) + ord(RW mod TEXTURE_SIZE > 0)) do
                Canvas.CopyRect(Bounds(X * TEXTURE_SIZE, 0, TEXTURE_SIZE,
                  TEXTURE_SIZE), Canvas, Rect(0, 0, TEXTURE_SIZE, TEXTURE_SIZE));

              // Tile first row all the way down
              for Y := 1 to ((RH div TEXTURE_SIZE) + ord(RH mod TEXTURE_SIZE > 0)) do
                Canvas.CopyRect(Bounds(0, Y * TEXTURE_SIZE, RW, TEXTURE_SIZE),
                  Canvas, Rect(0, 0, RW, TEXTURE_SIZE));

              // Above could be better if it reversed process when splitter was
              // taller than it was wider.  Optimized only for horizontal right now.
            end;
            // Copy texture bitmap to the screen.
            OffscreenBmp.Canvas.CopyRect(BtnRect, TextureBmp.Canvas,
              Rect(0, 0, RW, RH));
          finally
            TextureBmp.Free;
          end;
        end;
      end;
    end;
(**)
    Canvas.CopyRect(ButtonRect, OffscreenBmp.Canvas, Rect(0, 0,
      OffscreenBmp.Width, OffscreenBmp.Height));
  finally
    OffscreenBmp.Free;
  end;
end;

procedure TJvCustomNetscapeSplitter.SetAlign(Value: TAlign);
begin
  if Align <> Value then
  begin
    inherited Align := Value;
    Invalidate; // Direction changing, redraw arrows. 
  end;
end;

procedure TJvCustomNetscapeSplitter.SetAllowDrag(const Value: Boolean);
var
  Pt: TPoint;
begin
  if FAllowDrag <> Value then
  begin
    FAllowDrag := Value;
    // Have to reset cursor in case it's on the splitter at the moment
    GetCursorPos(Pt);
    Pt := ScreenToClient(Pt);
    ButtonHitTest(Pt.X, Pt.Y);
  end;
end;