strackbar.pas

AlphaControls是一个Delphi标准控件的集合

  FadeTimer.Enabled := False;
  if Assigned(FadeTimer) then FreeAndNil(FadeTimer);

  if Assigned(OldBmp) then FreeAndNil(OldBmp);
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  if Assigned(Thumb) then FreeAndNil(Thumb);
  inherited Destroy;
end;

procedure TsTrackBar.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  if Message.Result <> 1 then inherited;
end;

procedure TsTrackBar.PaintBody(aRect: TRect);
begin
  sStyle.PaintBG(sStyle.FCacheBMP);

  if IsValidSkinIndex(sStyle.SkinIndex) then begin
    if IsValidImgIndex(sStyle.BorderIndex) and (ma[sStyle.BorderIndex].Bmp.Width > 0) then begin
//      ma[i].Bmp.PixelFormat := pf24bit;
//      if sStyle.RegionChanged then begin
//        if sStyle.FRegion <> 0 then DeleteObject(sStyle.FRegion);
        sStyle.FRegion := 0;
        sStyle.FRegion := CreateRectRgn(0,
                                0,
                                Width,
                                Height);
//      end;
      PaintRasterBorder(sStyle.FCacheBmp, ma[sStyle.BorderIndex].Bmp, integer(sStyle.ControlIsActive), sStyle.FRegion, ma[sStyle.BorderIndex].TransparentColor, False);
//      if sStyle.RegionChanged then begin
        if HandleAllocated then SetWindowRgn(Handle, sStyle.FRegion, True);
        sStyle.RegionChanged := False;
//      end;
    end
    else begin
      if sStyle.ControlIsActive then begin
        sStyle.PaintBevel(sStyle.FCacheBmp, aRect, sStyle.ActualBevelWidth, sStyle.ActualBevel, sStyle.SoftControl);
      end
      else begin
        sStyle.PaintBevel(sStyle.FCacheBmp, aRect, BevelWidth, sStyle.ActualBevel, sStyle.SoftControl);
      end;
    end;
  end
  else if sStyle.BtnEffects.MaskedBorders.Enabled then begin
//    if sStyle.RegionChanged then begin
//      if sStyle.FRegion <> 0 then DeleteObject(sStyle.FRegion);
      sStyle.FRegion := 0;
      sStyle.FRegion := CreateRectRgn(0,
                                    0,
                                    Width,
                                    Height);

//    end;
    PaintRasterBorder(sStyle.FCacheBmp, GetBorder(sStyle), integer(sStyle.ControlIsActive), sStyle.FRegion, sStyle.BtnEffects.MaskedBorders.TransparentColor, False);
//    if sStyle.RegionChanged then begin
      if HandleAllocated then SetWindowRgn(Handle, sStyle.FRegion, True);
      sStyle.RegionChanged := False;
//    end;
  end
  else begin
    if sStyle.ControlIsActive then begin
      sStyle.PaintBevel(sStyle.FCacheBmp, aRect, sStyle.ActualBevelWidth, sStyle.ActualBevel, sStyle.SoftControl);
    end
    else begin
      sStyle.PaintBevel(sStyle.FCacheBmp, aRect, BevelWidth, sStyle.ActualBevel, sStyle.SoftControl);
    end;
  end;

  PaintBar;
  PaintThumb(Position);
end;

procedure TsTrackBar.PaintBar;
var
  w, h, i : integer;
  aRect : TRect;
  SaveIndex: Integer;
//  tBmp : TBitmap;
begin
  aRect := ChannelRect;
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, SliderChannelMask);
  if IsValidImgIndex(i) then begin
    ma[i].Bmp.PixelFormat := pf24bit;
    case Orientation of
      trHorizontal: begin
        h := ma[i].Bmp.Height div 2;
        w := HeightOf(aRect);
        aRect.Top := aRect.Top + (w - h) div 2;
        aRect.Bottom := aRect.Top + h;
      end;
      trVertical: begin
        h := ma[i].Bmp.Width div 2;
        w := WidthOf(aRect);
        aRect.Left := aRect.Left + (w - h) div 2;
        aRect.Right := aRect.Left + h;
      end;
    end;
    DrawMaskRect(sStyle.FCacheBmp, ma[i].Bmp,
                 integer(sStyle.ControlIsActive), aRect, ma[i].TransparentColor, True, EmptyCI);
  end
  else begin
    w := 1;
    PaintWnd(sStyle.FCacheBmp.Canvas, aRect, '', True, DT_CENTER);
    SaveIndex := SaveDC(sStyle.FCacheBmp.Canvas.Handle);
    DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, aRect, ColorToRGB(clBlack), ColorToRGB(clWhite), w);
    RestoreDC(sStyle.FCacheBmp.Canvas.Handle, SaveIndex);
  end;
  case Orientation of
    trHorizontal: begin
      PaintTicksHor;
    end;
    trVertical: begin
      PaintTicksVer;
    end;
  end;
end;

function TsTrackBar.Margin: integer;
begin
  Result := BorderWidth + integer(sStyle.ActualBevel <> cbNone);
end;

procedure TsTrackBar.PaintTicksHor;
var
  i, w, mh{, y1, y2} : integer;
  pa : TAPoint;
  pr, cr : TRect;
  SavedDC : hWnd;
begin
  pa := nil;
  if TickStyle <> tsNone then begin
    SavedDC := SaveDC(sStyle.FCacheBmp.Canvas.Handle);
    try
    pa := TicksArray;
    cr := ChannelRect;
    mh := (HeightOf(ThumbRect) - HeightOf(cr)) div 2 + 2;
    if (TickMarks = tmTopLeft) or (TickMarks = tmBoth) then begin
      for i := 0 to High(pa) do begin
        w := 1;
        pr := Rect(pa[i].x, cr.Top - mh - TickHeight, pa[i].x + 2, cr.Top - mh);
        DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, pr,
                        ColorToRGB(clBtnShadow),
                        ColorToRGB(clWhite), w);
      end;
    end;
    if (TickMarks = tmBottomRight) or (TickMarks = tmBoth) then begin
      for i := 0 to High(pa) do begin
        w := 1;
        pr := Rect(pa[i].x, cr.Bottom + mh, pa[i].x + 2, cr.Bottom + mh + TickHeight);
        DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, pr,
                        ColorToRGB(clBtnShadow),
                        ColorToRGB(clWhite), w);
      end;
    end;
    finally
      RestoreDC(sStyle.FCacheBmp.Canvas.Handle, SavedDC);
    end;
  end;
end;

procedure TsTrackBar.PaintThumb(i: integer);
var
  aRect : TRect;
  {w,} tw: integer;
  c: TsColor;
  Mode : integer;
begin
  aRect := ThumbRect;

  case Orientation of
    trHorizontal: begin
      i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, SliderHorzMask);
      if IsValidImgIndex(i) then begin
        if csLButtonDown in ControlState then begin
          Mode := 2;
        end
        else if sStyle.ControlIsActive then begin
          Mode := 1;
        end
        else Mode := 0;
        PaintRasterGlyph(sStyle.FCacheBmp, ma[i].Bmp,
                point(aRect.Left, aRect.Top), Mode, ma[i].TransparentColor);
        Exit;
      end;
    end;
    trVertical: begin
      i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, SliderVertMask);
      if IsValidImgIndex(i) then begin
        if csLButtonDown in ControlState then begin
          Mode := 2;
        end
        else if sStyle.ControlIsActive then begin
          Mode := 1;
        end
        else Mode := 0;
        PaintRasterGlyph(sStyle.FCacheBmp, ma[i].Bmp,
                point(aRect.Left, aRect.Top), Mode, ma[i].TransparentColor);
        Exit;
      end;
    end
  end;
  begin
//    w := 1;
    case TickMarks of
      tmBoth : begin
        TColor(c) := sStyle.ActiveColor;
//        DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, aRect, ColorToRGB(clWhite), ColorToRGB(clBlack), w);
      end;
      tmBottomRight : begin
        if Orientation = trHorizontal then begin
          tw := WidthOf(aRect) div 2;
          TColor(c) := sStyle.ActiveColor;
  //        SumBitmaps(sStyle.FCacheBmp, TempBmp, c);
          sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          sStyle.FCacheBmp.Canvas.Polyline([
                                  Point(aRect.Left + tw, aRect.Bottom - 1),
                                  Point(aRect.Left, aRect.Bottom - 1 - tw),
                                  Point(aRect.Left, aRect.Top),
                                  Point(aRect.Right, aRect.Top)
                                 ]);
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          sStyle.FCacheBmp.Canvas.PolyLine([
                                  Point(aRect.Right - 1, aRect.Top),
                                  Point(aRect.Right - 1, aRect.Bottom - 1 - tw),
                                  Point(aRect.Left + tw, aRect.Bottom - 1)
                                 ]);
        end
        else begin
          tw := HeightOf(aRect) div 2;
          sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          sStyle.FCacheBmp.Canvas.Polyline([
                                  Point(aRect.Left, aRect.Bottom - 1),
                                  Point(aRect.Left, aRect.Top),
                                  Point(aRect.Right - 1 - tw, aRect.Top),
                                  Point(aRect.Right - 1, aRect.Top + tw)
                                 ]);
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          sStyle.FCacheBmp.Canvas.PolyLine([
                                  Point(aRect.Left, aRect.Bottom - 1),
                                  Point(aRect.Right - 1 - tw, aRect.Bottom - 1),
                                  Point(aRect.Right - 1, aRect.Bottom - 1 - tw)
                                 ]);
        end;
      end;
      tmTopLeft : begin
        if Orientation = trHorizontal then begin
          tw := WidthOf(aRect) div 2;
          sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          sStyle.FCacheBmp.Canvas.Polyline([
                                  Point(aRect.Left, aRect.Bottom - 1),
                                  Point(aRect.Left, aRect.Top + tw),
                                  Point(aRect.Left + tw, aRect.Top)
                                 ]);
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          sStyle.FCacheBmp.Canvas.PolyLine([
                                  Point(aRect.Left + tw, aRect.Top),
                                  Point(aRect.Right - 1, aRect.Top + tw),
                                  Point(aRect.Right - 1, aRect.Bottom - 1),
                                  Point(aRect.Left, aRect.Bottom - 1)
                                 ]);
        end
        else begin
          tw := HeightOf(aRect) div 2;
          sStyle.FCacheBmp.Canvas.Pen.Style := psSolid;
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clWhite);
          sStyle.FCacheBmp.Canvas.Polyline([
                                  Point(aRect.Left, aRect.Top + tw),
                                  Point(aRect.Left + tw, aRect.Top),
                                  Point(aRect.Right - 1, aRect.Top)
                                 ]);
          sStyle.FCacheBmp.Canvas.Pen.Color := ColorToRGB(clBlack);
          sStyle.FCacheBmp.Canvas.PolyLine([
                                  Point(aRect.Right - 1, aRect.Top),
                                  Point(aRect.Right - 1, aRect.Bottom - 1),
                                  Point(aRect.Left + tw, aRect.Bottom - 1),
                                  Point(aRect.Left, aRect.Bottom - 1 - tw)
                                 ]);
        end;
      end;
    end;
  end;
end;

function TsTrackBar.CreateTempBmp: TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf24bit;
  Result.Width := sStyle.FCacheBmp.Width;
  Result.Height := sStyle.FCacheBmp.Height;
end;

procedure TsTrackBar.Invalidate;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, SLIDERHorzMASK);
  if i >= 0 then begin
    ThumbLength := ma[i].Bmp.Height div 2 + 2;
  end;                                   
  if not RestrictDrawing then FsStyle.BGChanged := True;
  inherited Invalidate;
end;

function TsTrackBar.ThumbRect: TRect;
begin
  Result := Rect(0, 0, 1, 1);
  SendMessage(Handle, TBM_GETTHUMBRECT, 0, longint(@Result));
end;

procedure TsTrackBar.PaintFromCache(aRect: TRect);
var
  SaveIndex: Integer;
  DC: HDC;
begin
  DC := GetWindowDC(Handle);
  SaveIndex := SaveDC(DC);
  sStyle.CopyFromCache(DC, aRect.Left, aRect.Top, aRect.Right, aRect.Bottom);
  RestoreDC(DC, SaveIndex);
  ReleaseDC(Handle, DC);
end;

function TsTrackBar.ChannelRect: TRect;
begin
  Result := Rect(0, 0, 1, 1);
  SendMessage(Handle, TBM_GETCHANNELRECT, 0, longint(@Result));
  if Orientation = trVertical then begin
    Changei(Result.Left, Result.Top);
    Changei(Result.Right, Result.Bottom);
  end;
end;

function TsTrackBar.TicPos(i: integer): TPoint;
begin
  Result := Point(0, 0);
  SendMessage(Handle, TBM_GETCHANNELRECT, 0, longint(@Result));
  inc(Result.x, WidthOf(ThumbRect) div 2 - 1);
end;

function TsTrackBar.TickCount: integer;
begin
  Result := SendMessage(Handle, TBM_GETNUMTICS, 0, 0);
end;

function TsTrackBar.TicksArray: TAPoint;
var
  i, w, {x,} c : integer;
  ChRect, ThRect : TRect;
begin
  Result := nil;
  ChRect := ChannelRect;
  ThRect := ThumbRect;
  c := iffi(TickStyle = tsAuto, TickCount, 2);

  if Orientation = trVertical then begin
    iStep := (HeightOf(ChRect) - HeightOf(ThRect)) / (TickCount - 1);
    w := HeightOf(ThRect) div 2;

    for i := 0 to c - 1 do begin
      SetLength(Result, i + 1);
      Result[i] := Point(0, Round(ChRect.Top + i * iStep + w));
    end;
  end
  else begin
    iStep := (WidthOf(ChRect) - WidthOf(ThRect)) / (TickCount - 1);
    w := WidthOf(ThRect) div 2;

    for i := 0 to c - 1 do begin
      SetLength(Result, i + 1);
      Result[i] := Point(Round(ChRect.Left + i * iStep + w), 0);
    end;
  end;
end;

procedure TsTrackBar.PaintTicksVer;
var
  i, w, mh{, y1, y2} : integer;
  pa : TAPoint;
  pr, cr : TRect;
begin
  pa := TicksArray;
  cr := ChannelRect;
  mh := (WidthOf(ThumbRect) - WidthOf(cr)) div 2 + 2;
  case TickStyle of
    tsNone: begin
    end;
    tsAuto: begin
      if (TickMarks = tmTopLeft) or (TickMarks = tmBoth) then begin
        for i := 0 to High(pa) do begin
          w := 1;
          pr := Rect(cr.Left - mh - TickHeight, pa[i].y, cr.Left - mh, pa[i].y + 2);
          DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, pr,
                          ColorToRGB(clBlack),
                          ColorToRGB(clWhite), w);
        end;
      end;
      if (TickMarks = tmBottomRight) or (TickMarks = tmBoth) then begin
        for i := 0 to High(pa) do begin
          w := 1;
          pr := Rect(cr.Right + mh, pa[i].y, cr.Right + mh + TickHeight, pa[i].y + 2);
          DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, pr,
                          ColorToRGB(clBlack),
                          ColorToRGB(clWhite), w);
        end;
      end;
    end;
    tsManual: begin
    end
  end;
end;

procedure TsTrackBar.SetParamsMsg;