tntdbctrlsex.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

      end
      else
        Offset := Point(0, 0);
      TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption, Layout, Margin, Spacing, FState,
        Transparent, DrawTextBiDiModeFlags(0), True);
    end
    else
{$ENDIF}
    begin
      PaintRect := Rect(0, 0, Width, Height);
      if not Flat then
      begin
        DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
        if FState in [bsDown, bsExclusive] then
          DrawFlags := DrawFlags or DFCS_PUSHED;
        DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
      end
      else
      begin
        if (FState in [bsDown, bsExclusive]) or
          (MouseInControl and (FState <> bsDisabled)) or
          (csDesigning in ComponentState) then
          DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
            FillStyles[Transparent] or BF_RECT)
        else if not Transparent then
        begin
          Canvas.Brush.Color := Color;
          Canvas.FillRect(PaintRect);
        end;
        InflateRect(PaintRect, -1, -1);
      end;
      if FState in [bsDown, bsExclusive] then
      begin
        if (FState = bsExclusive) and (not Flat or not MouseInControl) then
        begin
          Canvas.Brush.Bitmap := AllocPatternBitmap(clBtnFace, clBtnHighlight);
          Canvas.FillRect(PaintRect);
        end;
        Offset.X := 1;
        Offset.Y := 1;
      end
      else
      begin
        Offset.X := 0;
        Offset.Y := 0;
      end;
      TButtonGlyph_Draw(Self, Canvas, PaintRect, Offset, Caption,
        Layout, Margin, Spacing, FState, Transparent, DrawTextBiDiModeFlags(0)
        {$IFDEF COMPILER_7_UP}, True{$ENDIF});
    end;
  except
    on E: EAbortPaint do
      ;
  else
    raise;
  end;
end;

procedure TTntNavButton.Paint;
var
  R: TRect;
begin
  if FPaintInherited then
    inherited
  else
  begin
    NavButtonPaint;
    if (GetFocus = Parent.Handle) and
      (Index = THackDBNavigator(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;
end;

procedure TTntNavButton.CMHintShow(var Message: TMessage);
begin
  ProcessCMHintShowMsg(Message);
  inherited;
end;


procedure TTntNavButton.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;

procedure TTntNavButton.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TTntNavButton.UpdateInternalGlyphList;
begin
  FPaintInherited := True;
  try
    Repaint;
  finally
    FPaintInherited := False;
  end;
  Invalidate;
  raise EAbortPaint.Create('');
end;

(*
{ TTntDBRadioGroup }

constructor TTntDBRadioGroup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FValues := TTntStringList.Create;
end;

destructor TTntDBRadioGroup.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FValues.Free;
  inherited Destroy;
end;

procedure TTntDBRadioGroup.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TTntDBRadioGroup.UseRightToLeftAlignment: Boolean;
begin
  Result := inherited UseRightToLeftAlignment;
end;

procedure TTntDBRadioGroup.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
    Value := GetWideText(FDataLink.Field) else
    Value := '';
end;

procedure TTntDBRadioGroup.UpdateData(Sender: TObject);
begin
  if FDataLink.Field <> nil then SetWideText(FDataLink.Field, Value);
end;

function TTntDBRadioGroup.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TTntDBRadioGroup.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TTntDBRadioGroup.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TTntDBRadioGroup.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TTntDBRadioGroup.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TTntDBRadioGroup.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TTntDBRadioGroup.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TTntDBRadioGroup.GetButtonValue(Index: Integer): WideString;
begin
  if (Index < FValues.Count) and (FValues[Index] <> '') then
    Result := FValues[Index]
  else if Index < Items.Count then
    Result := Items[Index]
  else
    Result := '';
end;

procedure TTntDBRadioGroup.SetValue(const Value: WideString);
var
  I, Index: Integer;
begin
  if FValue <> Value then
  begin
    FInSetValue := True;
    try
      Index := -1;
      for I := 0 to Items.Count - 1 do
        if Value = GetButtonValue(I) then
        begin
          Index := I;
          Break;
        end;
      ItemIndex := Index;
    finally
      FInSetValue := False;
    end;
    FValue := Value;
    Change;
  end;
end;

procedure TTntDBRadioGroup.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    if ItemIndex >= 0 then
      TTntRadioButton(Controls[ItemIndex]).SetFocus else
      TTntRadioButton(Controls[0]).SetFocus;
    raise;
  end;
  inherited;
end;

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

procedure TTntDBRadioGroup.Click;
begin
  if not FInSetValue then
  begin
    inherited Click;
    if ItemIndex >= 0 then Value := GetButtonValue(ItemIndex);
    if FDataLink.Editing then FDataLink.Modified;
  end;
end;

procedure TTntDBRadioGroup.SetItems(Value: TTntStrings);
begin
  Items.Assign(Value);
  DataChange(Self);
end;

procedure TTntDBRadioGroup.SetValues(Value: TTntStrings);
begin
  FValues.Assign(Value);
  DataChange(Self);
end;

procedure TTntDBRadioGroup.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TTntDBRadioGroup.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ': FDataLink.Edit;
    #27: FDataLink.Reset;
  end;
end;

function TTntDBRadioGroup.CanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

function TTntDBRadioGroup.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (DataLink <> nil) and
    DataLink.ExecuteAction(Action);
end;

function TTntDBRadioGroup.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (DataLink <> nil) and
    DataLink.UpdateAction(Action);
end;
*)

(*
{ TTntDBCheckBox }

constructor TTntDBCheckBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  State := cbUnchecked;
  FValueCheck := WideLoadResString(@STextTrue);
  FValueUncheck := WideLoadResString(@STextFalse);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
  FPaintControl := TTntPaintControl.Create(Self, 'BUTTON');
  FPaintControl.Ctl3DButton := True;
end;

destructor TTntDBCheckBox.Destroy;
begin
  FPaintControl.Free;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TTntDBCheckBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TTntDBCheckBox.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

function TTntDBCheckBox.GetFieldState: TCheckBoxState;
var
  Text: WideString;
begin
  if FDatalink.Field <> nil then
    if FDataLink.Field.IsNull then
      Result := cbGrayed
    else if FDataLink.Field.DataType = ftBoolean then
      if FDataLink.Field.AsBoolean then
        Result := cbChecked
      else
        Result := cbUnchecked
    else
    begin
      Result := cbGrayed;
      Text := GetWideText(FDataLink.Field);
      if ValueMatch(FValueCheck, Text) then Result := cbChecked else
        if ValueMatch(FValueUncheck, Text) then Result := cbUnchecked;
    end
  else
    Result := cbUnchecked;
end;

procedure TTntDBCheckBox.DataChange(Sender: TObject);
begin
  State := GetFieldState;
end;

procedure TTntDBCheckBox.UpdateData(Sender: TObject);
var
  Pos: Integer;
  S: WideString;
begin
  if State = cbGrayed then
    FDataLink.Field.Clear
  else
    if FDataLink.Field.DataType = ftBoolean then
      FDataLink.Field.AsBoolean := Checked
    else
    begin
      if Checked then S := FValueCheck else S := FValueUncheck;
      Pos := 1;
      SetWideText(FDataLink.Field, WideExtractFieldName(S, Pos));
    end;
end;

function TTntDBCheckBox.ValueMatch(const ValueList, Value: WideString): Boolean;
var
  Pos: Integer;
begin
  Result := False;
  Pos := 1;
  while Pos <= Length(ValueList) do
    if WideCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
    begin
      Result := True;
      Break;
    end;
end;

procedure TTntDBCheckBox.Toggle;
begin
  if FDataLink.Edit then
  begin
    inherited Toggle;
    FDataLink.Modified;
  end;
end;

function TTntDBCheckBox.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TTntDBCheckBox.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TTntDBCheckBox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TTntDBCheckBox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TTntDBCheckBox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TTntDBCheckBox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TTntDBCheckBox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TTntDBCheckBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ':
      FDataLink.Edit;
    #27:
      FDataLink.Reset;
  end;
end;

procedure TTntDBCheckBox.SetValueCheck(const Value: WideString);
begin
  FValueCheck := Value;
  DataChange(Self);
end;

procedure TTntDBCheckBox.SetValueUncheck(const Value: WideString);
begin
  FValueUncheck := Value;
  DataChange(Self);
end;

procedure TTntDBCheckBox.WndProc(var Message: TMessage);
begin
  with Message do
    if (Msg = WM_CREATE) or (Msg = WM_WINDOWPOSCHANGED) or
      (Msg = CM_TEXTCHANGED) or (Msg = CM_FONTCHANGED) then
      FPaintControl.DestroyHandle;
  inherited;
end;

procedure TTntDBCheckBox.WMPaint(var Message: TWMPaint);
begin
  if not (csPaintCopy in ControlState) then inherited else
  begin
    SendMessage(FPaintControl.Handle, BM_SETCHECK, Ord(GetFieldState), 0);
    SendMessage(FPaintControl.Handle, WM_PAINT, Message.DC, 0);
  end;
end;

procedure TTntDBCheckBox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

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

function TTntDBCheckBox.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TTntDBCheckBox.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;*)

{ TTntDBEditEx }

procedure TTntDBEditEx.CMEnter(var Message: TCMEnter);
var
  FarEast: Boolean;
begin
  // Fix a bug of Delphi controls in Far East region
  FarEast := SysLocale.FarEast;
  SysLocale.FarEast := False;
  inherited;
  SysLocale.FarEast := FarEast;
end;

initialization
  BtnHintID[nbFirst] := @SFirstRecord;
  BtnHintID[nbPrior] := @SPriorRecord;
  BtnHintID[nbNext] := @SNextRecord;
  BtnHintID[nbLast] := @SLastRecord;
  BtnHintID[nbInsert] := @SInsertRecord;
  BtnHintID[nbDelete] := @SDeleteRecord;
  BtnHintID[nbEdit] := @SEditRecord;
  BtnHintID[nbPost] := @SPostEdit;
  BtnHintID[nbCancel] := @SCancelEdit;
  BtnHintID[nbRefresh] := @SRefreshRecord;

end.