strackbar.pas

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

begin
  if HandleAllocated then begin
    SendMessage(Handle, TBM_SETTHUMBLENGTH, FThumbLength, 0);
    SendMessage(Handle, TBM_SETLINESIZE, 0, FLineSize);
    SendMessage(Handle, TBM_SETPAGESIZE, 0, FPageSize);
    SendMessage(Handle, TBM_SETRANGEMIN, 0, FMin);
    SendMessage(Handle, TBM_SETRANGEMAX, 0, FMax);
    UpdateSelection;
    SendMessage(Handle, TBM_SETPOS, 1, FPosition);
    SendMessage(Handle, TBM_SETTICFREQ, FFrequency, 1);
  end;
end;

procedure TsTrackBar.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsTrackBar.PaintWnd(Canvas: TCanvas; aRect: TsRect; Text: string; Enabled: boolean; Flags: Integer);
  function SelRect : TRect; begin
    Result.Left := Round(aRect.Left + WidthOf(aRect) / (Max - Min) * (Position - Min));
    Result.Right := aRect.Right;
    Result.Top := aRect.Top;
    Result.Bottom := aRect.Bottom div 2;
  end;
begin
  Canvas.Brush.Color := ColorToRGB(sStyle.Painting.Color);
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psSolid;
//  aRect.Bottom := aRect.Bottom - 6;
  Canvas.FillRect(aRect);
end;

procedure TsTrackBar.PaintThumb(Bmp: TBitmap; i: integer);
var
  aRect : TRect;
  TempBmp : TBitmap;
  w, tw: integer;
  c: TsColor;
begin
  Bmp.Width := WidthOf(ThumbRect);
  Bmp.Height := HeightOf(ThumbRect);
  TempBmp := CreateTempBmp;
  TempBmp.Canvas.Brush.Style := bsSolid;
  TempBmp.Canvas.Brush.Color := ChangeColor(clBlack, clWhite, 0.5);

  try
  aRect := ThumbRect;

  w := 1;
  case TickMarks of
    tmBoth : begin
      TempBmp.Canvas.FillRect(aRect);
      TColor(c) := sStyle.ActiveColor;
      SumBitmaps(sStyle.FCacheBmp, TempBmp, c);
      DrawRectangleOnDC(sStyle.FCacheBmp.Canvas.Handle, aRect, ColorToRGB(clWhite), ColorToRGB(clBlack), w);
    end;
    tmBottomRight : begin
      TempBmp.Canvas.Pen.Style := psClear;
      if Orientation = trHorizontal then begin
        tw := WidthOf(aRect) div 2;
        TempBmp.Canvas.Polygon([
                                Point(aRect.Left, aRect.Top),
                                Point(aRect.Right, aRect.Top),
                                Point(aRect.Right, aRect.Bottom - 1 - tw),
                                Point(aRect.Right - tw, aRect.Bottom - 1),
                                Point(aRect.Left, aRect.Bottom - 1 - tw)
                               ]);
        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;
        TempBmp.Canvas.Polygon([
                                Point(aRect.Left, aRect.Top),
                                Point(aRect.Right - tw, aRect.Top),
                                Point(aRect.Right, aRect.Top + tw),
                                Point(aRect.Right - tw, aRect.Bottom - 1),
                                Point(aRect.Left, aRect.Bottom - 1)
                               ]);
        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, 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
      TempBmp.Canvas.Pen.Style := psClear;
      if Orientation = trHorizontal then begin
        tw := WidthOf(aRect) div 2;
        TempBmp.Canvas.Polygon([
                                Point(aRect.Left, aRect.Bottom),
                                Point(aRect.Left, aRect.Top + tw),
                                Point(aRect.Left + tw, aRect.Top),
                                Point(aRect.Right, aRect.Top + tw),
                                Point(aRect.Right, aRect.Bottom),
                                Point(aRect.Left, aRect.Bottom)
                               ]);
        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, 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;
        TempBmp.Canvas.Polygon([
                                Point(aRect.Left, aRect.Top + tw),
                                Point(aRect.Left + tw, aRect.Top),
                                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)
                               ]);
        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, 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;

  finally
    FreeAndNil(TempBmp);
  end;
end;

procedure TsTrackBar.PaintNewBmp;
begin
  PaintBody(Rect(0, 0, Width, Height));
end;

procedure TsTrackBar.StartFadeIn;
begin
  if sStyle.ActualFadingEnabled then begin
    OldBmp.Assign(sStyle.FCacheBmp);
    PaintNewBmp;
    FadeLevel := 1;
    FadeTimer.Enabled := False;
    FadeTimer.Interval := sStyle.ActualFadingIn;
    FadeTimer.Direction := fdUp;
  end;
end;

procedure TsTrackBar.StartFadeOut;
begin
  if sStyle.ActualFadingEnabled then begin
    OldBmp.Assign(sStyle.FCacheBmp);
    PaintNewBmp;
    FadeTimer.Enabled := False;
    FadeTimer.Interval := sStyle.ActualFadingOut;
    FadeTimer.Direction := fdDown;
  end;
end;

procedure TsTrackBar.StopFading;
begin
  if sStyle.ActualFadingEnabled then begin
    FadeTimer.Direction := fdNone;
    FadeLevel := sStyle.ActualFadingIter - 1;
  end;
end;

procedure TsTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  StopFading;
  inherited;
end;

procedure TsTrackBar.Paint;
var
  SaveIndex: Integer;
  CI : TCacheInfo;
  aRect : TRect;
begin
  if not (csDestroying in ComponentState) and not (csLoading in ComponentState) then begin
    sStyle.FCacheBmp.Width := Width;
    sStyle.FCacheBmp.Height := Height;
//    FBackBmp.Width := sStyle.FCacheBmp.Width;
//    FBackBmp.Height := sStyle.FCacheBmp.Height;

    PaintBody(Rect(0, 0, Width, Height));
    if not Enabled then begin
      CI := sStyle.GetParentCache;
      BmpDisabledKind(FsStyle.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
    end;

    aRect := Rect(0, 0, Width, Height);

    SaveIndex := SaveDC(Canvas.Handle);

    BitBlt(Canvas.Handle, 0, 0, Width, Height, FsStyle.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
//    sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);

    RestoreDC(Canvas.Handle, SaveIndex);
  end;
end;

procedure TsTrackBar.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsTrackBar.Loaded;
begin
  inherited;
  sStyle.Loaded;
end;

{
function TsTrackBar.GetMaskIndex(mask : string): integer;
var
  i, l : integer;
  s : string;
begin
  if Assigned(sSkinData.SkinFile) then begin
    l := Length(ma);
    s := sSkinData.SkinFile.ReadString(sStyle.SkinSection, 'Synonym', '');
    if l > 0 then begin
      for i := 0 to l - 1 do begin
        if (ma[i].ClassName = sStyle.SkinSection) and (UpperCase(ma[i].PropertyName) = mask) then begin
          Result := i;
          Exit;
        end;
      end;
      for i := 0 to l - 1 do begin
        if (ma[i].ClassName = s) and (UpperCase(ma[i].PropertyName) = mask) then begin
          Result := i;
          Exit;
        end;
      end;
    end;
  end;
  Result := -1;
end;

}
procedure TsTrackBar.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FsStyle.Invalidate;
  end;
end;

{ TFadeTimer }

constructor TFadeTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FOwner := TsTrackBar(AOwner);
  Direction := fdNone;
  OnTimer := TimerAction;
end;

procedure TFadeTimer.FadeDown;
var
  b : TBitmap;
  c : TsColor;
  DC, SavedDC: HDC;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) then Exit;
  b := TBitmap.Create;
  b.Width := FOwner.sStyle.FCacheBmp.Width;
  b.Height := FOwner.sStyle.FCacheBmp.Height;
  b.PixelFormat := pf24Bit;

  c.A := 0;
  c.R := 255 - FOwner.FadeLevel * 255 div FOwner.sStyle.ActualFadingIter;
  c.G := c.R;
  c.B := c.R;
  try
    BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FOwner.sStyle.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
    SumBitmaps(b, FOwner.OldBmp, c);

    dc := GetWindowDC(FOwner.Handle);
    SavedDC := SaveDC(DC);
    try
      BitBlt(DC, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(FOwner.Handle, DC);
    end;
  finally
    FreeAndNil(b);
    dec(FOwner.FadeLevel);
  end;
end;

procedure TFadeTimer.FadeUp;
var
  b : TBitmap;
  c : TsColor;
  DC, SavedDC: HDC;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) then Exit;
  b := TBitmap.Create;
  b.Width := FOwner.sStyle.FCacheBmp.Width;
  b.Height := FOwner.sStyle.FCacheBmp.Height;
  b.PixelFormat := pf24Bit;

  c.A := 0;
  c.R := 255 - FOwner.FadeLevel * 255 div FOwner.sStyle.ActualFadingIter;
  c.G := c.R;
  c.B := c.R;
  try
    BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FOwner.OldBmp.Canvas.Handle, 0, 0, SRCCOPY);
    SumBitmaps(b, FOwner.sStyle.FCacheBmp, c);

    dc := GetWindowDC(FOwner.Handle);
    SavedDC := SaveDC(DC);
    try
      BitBlt(DC, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
    finally
      RestoreDC(DC, SavedDC);
      ReleaseDC(FOwner.Handle, DC);
    end;
  finally
    FreeAndNil(b);
    inc(FOwner.FadeLevel);
  end;
end;

procedure TFadeTimer.SetDirection(const Value: TFadeDirection);
begin
  FDirection := Value;
  Enabled := Value <> fdNone;
end;

procedure TFadeTimer.Timer;
begin
  inherited;
  ToEnd;
  case FDirection of
    fdUp : FadeUp;
    fdDown : FadeDown;
    fdNone : Enabled := False;
  end;
end;

procedure TFadeTimer.TimerAction(Sender: TObject);
begin
end;

procedure TFadeTimer.ToEnd;
begin
  if (FOwner = nil) or (csDestroying in FOwner.ComponentState) or Application.Terminated then begin
    FDirection := fdNone;
  end else
  if (FOwner.FadeLevel > FOwner.sStyle.ActualFadingIter) then begin
    dec(FOwner.FadeLevel);
    FDirection := fdNone;
    if not RestrictDrawing then FOwner.sStyle.BGChanged := True;
    FOwner.Repaint;
  end else
  if (FOwner.FadeLevel < 0) then begin
    inc(FOwner.FadeLevel);
    FDirection := fdNone;
    if not RestrictDrawing then FOwner.sStyle.BGChanged := True;
    FOwner.Repaint;
  end;
end;

end.