const InitRepeatPause = 400; { pause before repeat timer (ms) } RepeatPause = 100; { pause before hint window displays (ms)} SpaceSize = 5; { size of space between special buttons }
type TNavbtnSkin=(Skin1,Skin2,Skin3,Skin4,Skin5,Skin6); TNavButton = class; TNavDataLink = class;
TNavGlyph = (ngEnabled, ngDisabled); TNavigateBtn = (nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh); TNavButtonSet = set of TNavigateBtn; TNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
ENavClick = procedure (Sender: TObject; Button: TNavigateBtn) of object;
procedure TDZNavigator.InitHints; var I: Integer; J: TNavigateBtn; begin if not Assigned(FDefHints) then begin FDefHints := TStringList.Create; for J := Low(Buttons) to High(Buttons) do FDefHints.Add(LoadResString(BtnHintId[J])); end; for J := Low(Buttons) to High(Buttons) do Buttons[J].Hint := FDefHints[Ord(J)]; J := Low(Buttons); for I := 0 to (FHints.Count - 1) do begin if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I]; if J = High(Buttons) then Exit; Inc(J); end; end;
procedure TDZNavigator.HintsChanged(Sender: TObject); begin InitHints; end;
procedure TDZNavigator.SetFlat(Value: Boolean); var I: TNavigateBtn; begin if FFlat <> Value then begin FFlat := Value; for I := Low(Buttons) to High(Buttons) do Buttons[I].Flat := Value; end; end;
procedure TDZNavigator.SetHints(Value: TStrings); begin if Value.Text = FDefHints.Text then FHints.Clear else FHints.Assign(Value); end;
procedure TDZNavigator.SetNavbtnSkin(const Value: TNavbtnSkin); begin if fNavbtnSkin <> Value then begin fNavbtnSkin := Value; UpdateNavbtnSkin; end; end;
function TDZNavigator.GetHints: TStrings; begin if (csDesigning in ComponentState) and not (csWriting in ComponentState) and not (csReading in ComponentState) and (FHints.Count = 0) then Result := FDefHints else Result := FHints; end;
procedure TDZNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent); begin end;
procedure TDZNavigator.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil; end;
procedure TDZNavigator.SetVisible(Value: TNavButtonSet); var I: TNavigateBtn; W, H: Integer; begin W := Width; H := Height; FVisibleButtons := Value; for I := Low(Buttons) to High(Buttons) do Buttons[I].Visible := I in FVisibleButtons; SetSize(W, H); if (W <> Width) or (H <> Height) then inherited SetBounds (Left, Top, W, H); Invalidate; end;
procedure TDZNavigator.UpdateNavbtnSkin; var I: TNavigateBtn; ResName: string; begin for I := Low(Buttons) to High(Buttons) do begin case fNavbtnSkin of Skin1: FmtStr(ResName, 'dbn_%s', [BtnTypeName[I]]); Skin2: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]); Skin3: FmtStr(ResName, 'dbn2_%s', [BtnTypeName[I]]); Skin4: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]); Skin5: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]); Skin6: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]); end; Buttons[I].Glyph.LoadFromResourceName(HInstance, ResName); end; end;
procedure TDZNavigator.CalcMinSize(var W, H: Integer); var Count: Integer; I: TNavigateBtn; begin if (csLoading in ComponentState) then Exit; if Buttons[nbFirst] = nil then Exit;
Count := 0; for I := Low(Buttons) to High(Buttons) do if Buttons[I].Visible then Inc(Count); if Count = 0 then Inc(Count);
W := Max(W, Count * MinBtnSize.X); H := Max(H, MinBtnSize.Y);
if Align = alNone then W := (W div Count) * Count; end;
procedure TDZNavigator.SetSize(var W: Integer; var H: Integer); var Count: Integer; I: TNavigateBtn; Space, Temp, Remain: Integer; X: Integer; begin if (csLoading in ComponentState) then Exit; if Buttons[nbFirst] = nil then Exit;
CalcMinSize(W, H);
Count := 0; for I := Low(Buttons) to High(Buttons) do if Buttons[I].Visible then Inc(Count); if Count = 0 then Inc(Count);
ButtonWidth := W div Count; Temp := Count * ButtonWidth; if Align = alNone then W := Temp;
X := 0; Remain := W - Temp; Temp := Count div 2; for I := Low(Buttons) to High(Buttons) do begin if Buttons[I].Visible then begin Space := 0; if Remain <> 0 then begin Dec(Temp, Remain); if Temp < 0 then begin Inc(Temp, Count); Space := 1; end; end; Buttons[I].SetBounds(X, 0, ButtonWidth + Space, Height); Inc(X, ButtonWidth + Space); end else Buttons[I].SetBounds (Width + 1, 0, ButtonWidth, Height); end; end;
procedure TDZNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); var W, H: Integer; begin W := AWidth; H := AHeight; if not HandleAllocated then SetSize(W, H); inherited SetBounds (ALeft, ATop, W, H); end;
procedure TDZNavigator.WMSize(var Message: TWMSize); var W, H: Integer; begin inherited; W := Width; H := Height; SetSize(W, H); end;
procedure TDZNavigator.WMWindowPosChanging(var Message: TWMWindowPosChanging); begin inherited; if (SWP_NOSIZE and Message.WindowPos.Flags) = 0 then CalcMinSize(Message.WindowPos.cx, Message.WindowPos.cy); end;
procedure TDZNavigator.ClickHandler(Sender: TObject); begin BtnClick (TNavButton (Sender).Index); end;
procedure TDZNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var OldFocus: TNavigateBtn; begin OldFocus := FocusedButton; FocusedButton := TNavButton (Sender).Index; if TabStop and (GetFocus <> Handle) and CanFocus then begin SetFocus; if (GetFocus <> Handle) then Exit; end else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then begin Buttons[OldFocus].Invalidate; Buttons[FocusedButton].Invalidate; end; end;
procedure TDZNavigator.BtnClick(Index: TNavigateBtn); begin if (DataSource <> nil) and (DataSource.State <> dsInactive) then begin if not (csDesigning in ComponentState) and Assigned(FBeforeAction) then FBeforeAction(Self, Index); with DataSource.DataSet do begin case Index of nbPrior: Prior; nbNext: Next; nbFirst: First; nbLast: Last; nbInsert: Insert; nbEdit: Edit; nbCancel: Cancel; nbPost: Post; nbRefresh: Refresh; nbDelete: if not FConfirmDelete or (MessageDlg(SDeleteRecordQuestion, mtConfirmation, mbOKCancel, 0) <> idCancel) then Delete; end; end; end; if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then FOnNavClick(Self, Index); end;
procedure TDZNavigator.WMSetFocus(var Message: TWMSetFocus); begin Buttons[FocusedButton].Invalidate; end;
procedure TDZNavigator.WMKillFocus(var Message: TWMKillFocus); begin Buttons[FocusedButton].Invalidate; end;
procedure TDZNavigator.KeyDown(var Key: Word; Shift: TShiftState); var NewFocus: TNavigateBtn; OldFocus: TNavigateBtn; begin OldFocus := FocusedButton; case Key of VK_RIGHT: begin if OldFocus < High(Buttons) then begin NewFocus := OldFocus; repeat NewFocus := Succ(NewFocus); until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible); if Buttons[NewFocus].Visible then begin FocusedButton := NewFocus; Buttons[OldFocus].Invalidate; Buttons[NewFocus].Invalidate; end; end; end; VK_LEFT: begin NewFocus := FocusedButton; repeat if NewFocus > Low(Buttons) then NewFocus := Pred(NewFocus); until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible); if NewFocus <> FocusedButton then begin FocusedButton := NewFocus; Buttons[OldFocus].Invalidate; Buttons[FocusedButton].Invalidate; end; end; VK_SPACE: begin if Buttons[FocusedButton].Enabled then Buttons[FocusedButton].Click; end; end; end;
procedure TDZNavigator.WMGetDlgCode(var Message: TWMGetDlgCode); begin Message.Result := DLGC_WANTARROWS; end;
procedure TDZNavigator.DataChanged; var UpEnable, DnEnable: Boolean; begin UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF; DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF; Buttons[nbFirst].Enabled := UpEnable; Buttons[nbPrior].Enabled := UpEnable; Buttons[nbNext].Enabled := DnEnable; Buttons[nbLast].Enabled := DnEnable; Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify and not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF); end;
procedure TDZNavigator.EditingChanged; var CanModify: Boolean; begin CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify; Buttons[nbInsert].Enabled := CanModify; Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing; Buttons[nbPost].Enabled := CanModify and FDataLink.Editing; Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing; Buttons[nbRefresh].Enabled := CanModify; end;
procedure TDZNavigator.ActiveChanged; var I: TNavigateBtn; begin if not (Enabled and FDataLink.Active) then for I := Low(Buttons) to High(Buttons) do Buttons[I].Enabled := False else begin DataChanged; EditingChanged; end; end;
procedure TDZNavigator.CMEnabledChanged(var Message: TMessage); begin inherited; if not (csLoading in ComponentState) then ActiveChanged; end;
procedure TDZNavigator.SetDataSource(Value: TDataSource); begin FDataLink.DataSource := Value; if not (csLoading in ComponentState) then ActiveChanged; if Value <> nil then Value.FreeNotification(Self); end;
function TDZNavigator.GetDataSource: TDataSource; begin Result := FDataLink.DataSource; end;
procedure TDZNavigator.Loaded; var W, H: Integer; begin inherited Loaded; W := Width; H := Height; SetSize(W, H); if (W <> Width) or (H <> Height) then inherited SetBounds (Left, Top, W, H); InitHints; ActiveChanged; end;
{TNavButton}
destructor TNavButton.Destroy; begin if FRepeatTimer <> nil then FRepeatTimer.Free; inherited Destroy; end;
procedure TNavButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown (Button, Shift, X, Y); if nsAllowTimer in FNavStyle then begin if FRepeatTimer = nil then FRepeatTimer := TTimer.Create(Self);
procedure TNavButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseUp (Button, Shift, X, Y); if FRepeatTimer <> nil then FRepeatTimer.Enabled := False; end;
procedure TNavButton.TimerExpired(Sender: TObject); begin FRepeatTimer.Interval := RepeatPause; if (FState = bsDown) and MouseCapture then begin try Click; except FRepeatTimer.Enabled := False; raise; end; end; end;
procedure TNavButton.Paint; var R: TRect; begin inherited Paint; if (GetFocus = Parent.Handle) and (FIndex = TDZNavigator (Parent).FocusedButton) then begin R := Bounds(0, 0, Width, Height); InflateRect(R, -3, -3); if FState = bsDown then OffsetRect(R, 1, 1); Canvas.Brush.Style := bsSolid; Font.Color := clBtnShadow; DrawFocusRect(Canvas.Handle, R); end; end;
