flatctrdb.pas

comerose_flatstyle_v4.42.9.0_d7.rar

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

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

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

constructor TFlatDBFloat.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;
end;

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

procedure TFlatDBFloat.DataChange(sender : TObject);
begin
  if (FDataLink.Field <> nil) and
       ((FDataLink.Field is TFloatField) or (FDataLink.Field is TCurrencyField))  then
    value := FDataLink.Field.AsFloat
  else
    value := 0.00;
end;

procedure TFlatDBFloat.UpdateData(sender : TObject);
begin
  if (FDataLink.Field <> nil)  and
       ((FDataLink.Field is TFloatField) or (FDataLink.Field is TCurrencyField))  then
    FDataLink.Field.AsFloat :=  value  ;
end;

procedure TFlatDBFloat.ActiveChange(sender : TObject);
begin
  Enabled := FDataLink.Active and (FDataLink.Field <> nil);
end;

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

procedure TFlatDBFloat.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TFlatDBFloat.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    {^H, ^V, ^X,} #48..#57:
      FDataLink.Edit;
    #27:                              //esc取消
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

procedure TFlatDBFloat.Change;
begin
  if FDataLink <> nil then
    FDataLink.Modified;
  inherited Change;
end;

procedure TFlatDBFloat.DownClick (Sender: TObject);
begin
  inherited DownClick (Sender);
  FDataLink.Edit;
end;

procedure TFlatDBFloat.UpClick (Sender: TObject);
begin
  inherited UpClick (Sender);
  FDataLink.Edit;
end;     

{ TFlatDBInteger }
     
function TFlatDBInteger.GetDataField : String;
begin
  Result := FDataLink.FieldName;
end;

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

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

 
procedure TFlatDBInteger.SetReadOnly (aValue : Boolean);
begin
  FDataLink.ReadOnly := aValue;
  inherited ReadOnly := aValue;
end;


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

 
procedure TFlatDBInteger.SetDataField (const aValue : String);
begin
  FDataLink.FieldName := aValue;
end;

 
procedure TFlatDBInteger.DataChange (Sender : TObject);
begin
  if FDataLink.Field <> nil then
    begin
      if not (csDesigning in ComponentState) then
        begin
          if (FDataLink.Field.DataType = ftInteger) and (MaxLength = 0) then
            MaxLength := FDataLink.Field.Size;
        end;
      if {FFocused and} FDataLink.CanModify then
        begin
          Value := FDataLink.Field.AsInteger;
        end
      else
        begin
          Value := FDataLink.Field.AsInteger;
        end;
    end
end;
 
procedure TFlatDBInteger.UpdateData(Sender: TObject);
begin
  FDataLink.Field.AsInteger := Value; { Value, Text }
end;

 
procedure TFlatDBInteger.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

 
procedure TFlatDBInteger.WMPaste(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;
 
procedure TFlatDBInteger.WMCut(var Message: TMessage);
begin
  FDataLink.Edit;
  inherited;
end;              

procedure TFlatDBInteger.Change;
begin
  if FDataLink <> nil then
    FDataLink.Modified;
  inherited Change;
end;


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


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

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

procedure TFlatDBInteger.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TFlatDBInteger.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    {^H, ^V, ^X,} #48..#57:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

procedure TFlatDBInteger.DownClick (Sender: TObject);
begin
  inherited DownClick (Sender);
  FDataLink.Edit;
end;

procedure TFlatDBInteger.UpClick (Sender: TObject);
begin
  inherited UpClick (Sender);
  FDataLink.Edit;
end;

constructor TFlatDBInteger.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  ControlStyle:=ControlStyle-[csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
end;

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

{ TFlatDBMaskEdit }

procedure TFlatDBMaskEdit.ActiveChange(Sender: TObject);
begin
  ResetMaxLength;
end;

procedure TFlatDBMaskEdit.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

procedure TFlatDBMaskEdit.CMEnter(var Message: TCMEnter);
begin
  SetFocused(True);
  inherited;
  if SysLocale.FarEast and FDataLink.CanModify then
    inherited ReadOnly := False;
end;

procedure TFlatDBMaskEdit.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  SetFocused(False);
  DoExit;
end;

procedure TFlatDBMaskEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := SizeOf(FDataLink);
end;

constructor TFlatDBMaskEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;
end;

procedure TFlatDBMaskEdit.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
  begin
    if FAlignment <> FDataLink.Field.Alignment then
    begin
      Text := '';  {forces update}
      FAlignment := FDataLink.Field.Alignment;
    end;
    if not (csDesigning in ComponentState) then
    begin
      if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
        MaxLength := FDataLink.Field.Size;
    end;
    if FFocused and FDataLink.CanModify then
      Text := FDataLink.Field.Text
    else
    begin
      Text := FDataLink.Field.DisplayText;
      if FDataLink.Editing  then
        Modified := True;
    end;
  end else
  begin
    FAlignment := taLeftJustify;
    if csDesigning in ComponentState then
      Text := Name else
      Text := '';
  end;
end;

destructor TFlatDBMaskEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TFlatDBMaskEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

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

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

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

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

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

function TFlatDBMaskEdit.GetTextMargins: TPoint;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  if NewStyleControls then
  begin
    if BorderStyle = bsNone then I := 0 else
      if Ctl3D then I := 1 else I := 2;
    Result.X := SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF + I;
    Result.Y := I;
  end else
  begin
    if BorderStyle = bsNone then I := 0 else
    begin
      DC := GetDC(0);
      GetTextMetrics(DC, SysMetrics);
      SaveFont := SelectObject(DC, Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
      ReleaseDC(0, DC);
      I := SysMetrics.tmHeight;
      if I > Metrics.tmHeight then I := Metrics.tmHeight;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;

procedure TFlatDBMaskEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TFlatDBMaskEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;