fctrackbar.pas

一套及时通讯的原码

       r.left := RulerRect.Left + ((RulerRect.Right - RulerRect.Left) - Canvas.TextWidth(valstr)) div 2;
       r.left:= r.left + TextAttributes.OffsetX + 3;
       r.top:= TextAttributes.OffsetY + 1
     end
     else if TextAttributes.Position = tbtBottom then
     begin
       r.left := RulerRect.Left + ((RulerRect.Right - RulerRect.Left) - Canvas.TextWidth(valstr)) div 2;
       r.left:= r.left + TextAttributes.OffsetX + 3;
       r.top:= ClientHeight - Canvas.TextHeight(valstr) - TextAttributes.OffsetY - 3;
     end;

     SetBkMode(Canvas.Handle, windows.TRANSPARENT);
     Drawflags:= DT_NOPREFIX;
     DrawText(Canvas.Handle, pchar(valstr), length(valstr), r, DrawFlags);
   end;
end;

procedure TfcTrackBar.SetThumbColor(val: TColor);
begin
   if val<>FThumbColor then
   begin
      FThumbColor:= val;
      Invalidate;
   end
end;


procedure TfcTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
    X, Y: Integer);
var pt:TPoint;
    tbr: TRect;
begin
   if CanFocus then SetFocus;

   inherited;
   pt := ScreenToClient(Mouse.CursorPos);
   tbr:= GetTrackBarRect;
   InflateRect( tbr, 2, 2);
   if not PtInRect(tbr, pt) then exit;

   if FRepeatTimer = nil then
     FRepeatTimer := TfcTrackRepeatTimer.Create(Self);

   if orientation = trfcHorizontal then
   begin
      if (pt.x<trackbutton.left) then
      begin
         if inverted then
         begin
           Position:= Position + Increment;
           FRepeatTimer.Increment:= Increment;
         end
         else begin
           Position:= Position - Increment;
           FRepeatTimer.Increment:= -Increment;
         end;
      end
      else if (pt.x>trackbutton.left + trackbutton.Width) then
      begin
         if inverted then
         begin
           Position:= Position - Increment;
           FRepeatTimer.Increment:= -Increment;
         end
         else begin
           Position:= Position + Increment;
           FRepeatTimer.Increment:= Increment;
         end
      end
   end
   else begin
      if (pt.y<trackbutton.top) then
      begin
         if Inverted then
         begin
           Position:= Position + Increment;
           FRepeatTimer.Increment:= Increment;
         end
         else begin
           Position:= Position - Increment;
           FRepeatTimer.Increment:= -Increment;
         end;
      end
      else if (pt.y>trackbutton.top + trackbutton.height) then
      begin
         if Inverted then
         begin
           Position:= Position - Increment;
           FRepeatTimer.Increment:= -Increment;
         end
         else begin
           Position:= Position + Increment;
           FRepeatTimer.Increment:= Increment;
         end;
      end
   end;

   FRepeatTimer.OnTimer := TimerExpired;
   FRepeatTimer.Interval := InitRepeatPause;
   FRepeatTimer.Enabled  := True;

end;

procedure TfcTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState;
                                  X, Y: Integer);
begin
  inherited MouseUp (Button, Shift, X, Y);
  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled  := False;
end;

procedure TfcTrackBar.TimerExpired(Sender: TObject);
var pt:TPoint;
begin
    try
       FRepeatTimer.Interval := RepeatPause;
       pt := ScreenToClient(Mouse.CursorPos);

       if orientation = trfcHorizontal then
       begin
          if (pt.y>ClientHeight) or (pt.y<0) then
             FRepeatTimer.Enabled:= False
          else if Inverted then
          begin
             if (pt.x<trackbutton.left) and (FRepeatTimer.Increment>0) then
                Position:= Position + Increment
             else if (pt.x>trackbutton.left + trackbutton.Width) and (FRepeatTimer.Increment<0) then
                Position:= Position - Increment
             else FRepeatTimer.Enabled:= False
          end
          else if (pt.x<trackbutton.left) and (FRepeatTimer.Increment<0) then
             Position:= Position - Increment
          else if (pt.x>trackbutton.left + trackbutton.Width) and (FRepeatTimer.Increment>0) then
             Position:= Position + Increment
          else
             FRepeatTimer.Enabled:= False
       end
       else begin
          if (pt.x>ClientWidth) or (pt.x<0) then
             FRepeatTimer.Enabled:= False
          else if Inverted then
          begin
             if (pt.y<trackbutton.top) and (FRepeatTimer.Increment>0) then
                Position:= Position + Increment
             else if (pt.y>trackbutton.top + trackbutton.height) and (FRepeatTimer.Increment<0) then
                Position:= Position - Increment
             else
                FRepeatTimer.Enabled:= False
          end
          else if (pt.y<trackbutton.top) and (FRepeatTimer.Increment<0) then
             Position:= Position - Increment
          else if (pt.y>trackbutton.top + trackbutton.height) and (FRepeatTimer.Increment>0) then
             Position:= Position + Increment
          else
             FRepeatTimer.Enabled:= False
       end;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
end;

procedure TfcTrackBar.KeyDown(var Key: word; Shift: TShiftState);
begin
   inherited;
   if Key in [vk_right, vk_down] then
   begin
     if Inverted then
       Position:= Position - Increment
     else
       Position:= Position + Increment
   end
   else if key in [vk_left, vk_up] then begin
     if Inverted then
       Position:= Position + Increment
     else
       Position:= Position - Increment;
   end
   else if key = vk_next then
   begin
     if Inverted then
       Position:= Position - PageSize
     else
       Position:= Position + PageSize;
   end
   else if key = vk_prior then
   begin
     if Inverted then
       Position:= Position + PageSize
     else
       Position:= Position - PageSize;
   end;
end;

procedure TfcTrackBar.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS;
end;

procedure TfcTrackBar.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
end;

procedure TfcTrackBar.CMEnter(var Message: TCMEnter);
begin
   inherited;
   invalidate;
end;

procedure TfcTrackBar.CMExit(var Message: TCMExit);
begin
   inherited;
   UpdateRecord;
   invalidate;
end;

procedure TfcTrackBar.UpdateRecord;
//var lastModified: boolean;
begin
//  lastModified:= modified;
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
//    modified:= lastModified;
    raise;
  end;
end;



Function TfcTrackBar.GetDBValue: Double;
var Value: Double;
begin
   if (FDataLink.Field <> nil) and (Datasource<>nil) and (Datasource.state = dsBrowse) then
   begin
      Value:= FDataLink.Field.AsFloat;
      result:= Value;
   end
   else begin
      result:= GetPosition;
   end;
end;

Function TfcTrackBar.GetPosition: Double;
var Value: Double;
begin
   if (csPaintCopy in  ControlState) and (FDataLink.Field <> nil) then
   begin
      Value:= FDataLink.Field.AsFloat;
      Value:= Round(Value / Increment) * Increment;
      result:= Value;
   end
   else begin
      result:= FPosition;
   end;
end;

procedure TfcTrackBar.PositionChanging;
begin
   if csDesigning in ComponentState then exit;
   if Skipedit then exit;
   if EditCanModify then DataLink.Edit;
end;

function TfcTrackBar.EffectiveReadOnly: Boolean;
begin
  result:= FReadOnly or FDataLink.ReadOnly or
           ((FDataLink.Field<>nil) and (not FDataLink.Field.CanModify));
end;

function TfcTrackBar.EditCanModify: Boolean;
begin
  result:= False;
  if EffectiveReadOnly then exit;

  // Respect autoedit
  if (DataSource<>Nil) and (not DataSource.autoEdit) then
     if (not (DataSource.state in [dsEdit, dsInsert])) then exit;

  if FDatalink.Field <> nil then result := FDataLink.Edit
  else result := True;
end;

procedure TfcTrackBar.UpdateData(Sender: TObject);
begin
    if (FDataLink.Field.asFloat <> Position) then
       FDataLink.Field.asFloat:= Position;
end;

procedure TfcTrackBarText.SetFont(Value: TFont);
begin
  Owner.Font.Assign(Value);
  Owner.Invalidate;
end;

procedure TfcTrackBarText.SetPosition(Value: TfcTrackBarTextPosition);
begin
   FPosition:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetOffsetX(Value: integer);
begin
   FOffsetX:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetOffsetY(Value: integer);
begin
   FOffsetY:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetDisplayFormat(Value: String);
begin
   FDisplayFormat:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetShowText(Value: boolean);
begin
   FShowText:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetTickLabelFrequency(Value: integer);
begin
   FTickLabelFrequency:= Value;
   Owner.Invalidate;
end;

procedure TfcTrackBarText.SetTickDisplayFormat(Value: string);
begin
   FTickDisplayFormat:= Value;
   Owner.Invalidate;
end;

function TfcTrackBarText.GetFont: TFont;
begin
   result:= Owner.Font;
end;

constructor TfcTrackBarText.Create(AOwner: TComponent);
begin
   inherited Create;
   Owner:= AOwner as TfcTrackBar;
   FOffsetX:= 0;
   FOffsetY:= 0;
   FPosition:= tbtLeft;
   FShowText:= False;
   FTickLabelFrequency:= 0;
end;

procedure TfcTrackBar.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TfcTrackBar.SetSpacingLeftTop(Value: integer);
begin
   FSpacingLeftTop:= Value;
   Invalidate;
end;

procedure TfcTrackBar.SetSpacingRightBottom(Value: integer);
begin
   FSpacingRightBottom:= Value;
   Invalidate;
end;

procedure TfcTrackBar.SetSpacingEdgeTrackbar(Value: integer);
begin
   FSpacingEdgeTrackbar:= Value;
   Invalidate;
end;

procedure TfcTrackBar.SetTrackColor(Value: TColor);
begin
   if Value<>FTrackColor then
   begin
      FTrackColor:= Value;
      Invalidate;
   end
end;

procedure TfcTrackBar.SetTrackPartialFillColor(Value: TColor);
begin
   if Value<>FTrackPartialFillColor then
   begin
      FTrackPartialFillColor:= Value;
      Invalidate;
   end
end;


end.