rm_dialogctls.pas

这是一个功能强大

  ComboBox := Control as TComboBox;
  with ComboBox.Canvas do
  begin
    FillRect(Rect);
    s := ComboBox.Items[Index];
    if Pos(';', s) <> 0 then
      s := Copy(s, 1, Pos(';', s) - 1);
    TextOut(Rect.Left + 2, Rect.Top + 1, s);
  end;
end;

function TRMComboBoxControl.GetItems: TStrings;
begin
  Result := FComboBox.Items;
end;

procedure TRMComboBoxControl.SetItems(Value: TStrings);
begin
  FComboBox.Items.Assign(Value);
end;

function TRMComboBoxControl.GetItemIndex: Integer;
begin
  Result := FComboBox.ItemIndex;
end;

procedure TRMComboBoxControl.SetItemIndex(Value: Integer);
begin
  FComboBox.ItemIndex := Value;
end;

function TRMComboBoxControl.GetText: string;
begin
  Result := FComboBox.Text;
  if (Style = rmcsLookup) and (Pos(';', Result) <> 0) then
    Result := Trim(Copy(Result, Pos(';', Result) + 1, 255));
end;

procedure TRMComboBoxControl.SetText(Value: string);
begin
  FComboBox.Text := Value;
end;

procedure TRMComboBoxControl.SetStyle(Value: TRMComboBoxStyle);
begin
  FStyle := Value;
  FComboBox.Style := TComboBoxStyle(Value);
end;

{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMDateEditControl }

class procedure TRMDateEditControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 186;
  aKy := 21;
end;

constructor TRMDateEditControl.Create;
begin
  inherited Create;
  BaseName := 'DateEdit';

  FDateEdit := TDateTimePicker.Create(nil);
  FDateEdit.Parent := RMDialogForm;
  AssignControl(FDateEdit);
end;

destructor TRMDateEditControl.Destroy;
begin
  FreeAndNil(FDateEdit);
  inherited Destroy;
end;

procedure TRMDateEditControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Date := RMReadFloat(aStream);
  Time := RMReadFloat(aStream);
  DateFormat := TDTDateFormat(RMReadByte(aStream));
  Kind := TDateTimeKind(RMReadByte(aStream));
end;

procedure TRMDateEditControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteFloat(aStream, Date);
  RMWriteFloat(aStream, Time);
  RMWriteByte(aStream, Byte(DateFormat));
  RMWriteByte(aStream, Byte(Kind));
end;

function TRMDateEditControl.GetDate: TDate;
begin
  Result := FDateEdit.Date;
end;

procedure TRMDateEditControl.SetDate(Value: TDate);
begin
  FDateEdit.Date := Value;
end;

function TRMDateEditControl.GetTime: TTime;
begin
  Result := FDateEdit.Time;
end;

procedure TRMDateEditControl.SetTime(Value: TTime);
begin
  FDateEdit.Time := Value;
end;

function TRMDateEditControl.GetDateFormat: TDTDateFormat;
begin
  Result := FDateEdit.DateFormat;
end;

procedure TRMDateEditControl.SetDateFormat(Value: TDTDateFormat);
begin
  FDateEdit.DateFormat := Value;
end;

function TRMDateEditControl.GetKind: TDateTimeKind;
begin
  Result := FDateEdit.Kind;
end;

procedure TRMDateEditControl.SetKind(Value: TDateTimeKind);
begin
  FDateEdit.Kind := Value;
end;

{$IFDEF JVCLCTLS}
{-----------------------------------------------------------------------------}
{-----------------------------------------------------------------------------}
{ TRMRXDateEditControl }

class procedure TRMRXDateEditControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 121;
  aKy := 21;
end;

constructor TRMRXDateEditControl.Create;
begin
  inherited Create;
  BaseName := 'RxDateEdit';

  FDateEdit := TJvDateEdit.Create(nil);
  FDateEdit.Parent := RMDialogForm;
  FDateEdit.ButtonWidth := 19;
  AssignControl(FDateEdit);
end;

destructor TRMRXDateEditControl.Destroy;
begin
  FreeAndNil(FDateEdit);
  inherited Destroy;
end;

function TRMRXDateEditControl.GetPropValue(aObject: TObject; aPropName: string;
  var aValue: Variant; Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'DATE' then
    aValue := FDateEdit.Date
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

function TRMRXDateEditControl.SetPropValue(aObject: TObject; aPropName: string;
  aValue: Variant): Boolean;
begin
  Result := True;
  if aPropName = 'DATE' then
    FDateEdit.Date := aValue
  else
    Result := inherited SetPropValue(aObject, aPropName, aValue);
end;

procedure TRMRXDateEditControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  Text := RMReadString(aStream);
  DialogTitle := RMReadString(aStream);
  StartOfWeek := TDayOfWeekName(RMReadByte(aStream));
  YearDigits := TYearDigits(RMReadByte(aStream));
  ClickKey := TShortCut(RMReadByte(aStream));
  CalendarStyle := TCalendarStyle(RMReadByte(aStream));
  DefaultToday := RMReadBoolean(aStream);
end;

procedure TRMRXDateEditControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteString(aStream, Text);
  RMWriteString(aStream, DialogTitle);
  RMWriteByte(aStream, Byte(StartOfWeek));
  RMWriteByte(aStream, Byte(YearDigits));
  RMWriteByte(aStream, Byte(ClickKey));
  RMWriteByte(aStream, Byte(CalendarStyle));
  RMWriteBoolean(astream, DefaultToday);
end;

function TRMRXDateEditControl.GetText: string;
begin
  Result := FDateEdit.Text;
end;

procedure TRMRXDateEditControl.SetText(Value: string);
begin
  FDateEdit.Text := Value;
end;

function TRMRXDateEditControl.GetDialogTitle: string;
begin
  Result := FDateEdit.DialogTitle;
end;

procedure TRMRXDateEditControl.SetDialogTitle(Value: string);
begin
  FDateEdit.DialogTitle := Value;
end;

function TRMRXDateEditControl.GetStartOfWeek: TDayOfWeekName;
begin
  Result := FDateEdit.StartOfWeek;
end;

procedure TRMRXDateEditControl.SetStartOfWeek(Value: TDayOfWeekName);
begin
  FDateEdit.StartOfWeek := Value;
end;

function TRMRXDateEditControl.GetYearDigits: TYearDigits;
begin
  Result := FDateEdit.YearDigits;
end;

procedure TRMRXDateEditControl.SetYearDigits(Value: TYearDigits);
begin
  FDateEdit.YearDigits := Value;
end;

function TRMRXDateEditControl.GetClickKey: TShortCut;
begin
  Result := FDateEdit.ClickKey;
end;

procedure TRMRXDateEditControl.SetClickKey(Value: TShortCut);
begin
  FDateEdit.ClickKey := Value;
end;

function TRMRXDateEditControl.GetCalendarStyle: TCalendarStyle;
begin
  Result := FDateEdit.CalendarStyle;
end;

procedure TRMRXDateEditControl.SetCalendarStyle(Value: TCalendarStyle);
begin
  FDateEdit.CalendarStyle := Value;
end;

function TRMRXDateEditControl.GetDefaultToday: Boolean;
begin
  Result := FDateEdit.DefaultToday;
end;

procedure TRMRXDateEditControl.SetDefaultToday(Value: Boolean);
begin
  FDateEdit.DefaultToday := Value;
end;
{$ENDIF}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMCheckListBox }

class procedure TRMCheckListBoxControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 121;
  aKy := 97;
end;

constructor TRMCheckListBoxControl.Create;
begin
  inherited Create;
  BaseName := 'CheckListBox';

  FCheckListBox := TCheckListBox.Create(nil);
  FCheckListBox.Parent := RMDialogForm;

  AssignControl(FCheckListBox);
end;

destructor TRMCheckListBoxControl.Destroy;
begin
  FreeAndNil(FCheckListBox);
  inherited Destroy;
end;

function TRMCheckListBoxControl.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'CHECKLISTBOX' then
    aValue := O2V(FCheckListBox)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMCheckListBoxControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  RMReadMemo(aStream, Items);
  ItemIndex := RMReadInt32(aStream);
end;

procedure TRMCheckListBoxControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteMemo(aStream, Items);
  RMWriteInt32(aStream, ItemIndex);
end;

function TRMCheckListBoxControl.GetItems: TStrings;
begin
  Result := FCheckListBox.Items;
end;

procedure TRMCheckListBoxControl.SetItems(Value: TStrings);
begin
  FCheckListBox.Items.Assign(Value);
end;

function TRMCheckListBoxControl.GetItemIndex: Integer;
begin
  Result := FCheckListBox.ItemIndex;
end;

procedure TRMCheckListBoxControl.SetItemIndex(Value: Integer);
begin
  FCheckListBox.ItemIndex := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPanelControl }

class procedure TRMPanelControl.DefaultSize(var aKx, aKy: Integer);
begin
  aKx := 185;
  aKy := 41;
end;

constructor TRMPanelControl.Create;
begin
  inherited Create;
  BaseName := 'Panel';

  FPanel := TPanel.Create(nil);
  FPanel.Parent := RMDialogForm;

  AssignControl(FPanel);
end;

destructor TRMPanelControl.Destroy;
begin
  FreeChildViews;
  FreeAndNil(FPanel);
  inherited Destroy;
end;

function TRMPanelControl.IsContainer: Boolean;
begin
  Result := True;
end;

function TRMPanelControl.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'PANEL' then
    aValue := O2V(FPanel)
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

procedure TRMPanelControl.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
  BevelInner := TPanelBevel(RMReadByte(aStream));
  BevelOuter := TPanelBevel(RMReadByte(aStream));
  BevelWidth := RMReadInt32(aStream);
  BorderStyle := TBorderStyle(RMReadByte(aStream));
  BorderWidth := RMReadInt32(aStream);
  Caption := RMReadString(aStream);
end;

procedure TRMPanelControl.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
  RMWriteByte(aStream, Integer(BevelInner));
  RMWriteByte(aStream, Integer(BevelOuter));
  RMWriteInt32(aStream, BevelWidth);
  RMWriteByte(aStream, Integer(BorderStyle));
  RMWriteInt32(aStream, BorderWidth);
  RMWriteString(aStream, Caption);
end;

function TRMPanelControl.GetBevelInner: TPanelBevel;
begin
  Result := FPanel.BevelInner;
end;

procedure TRMPanelControl.SetBevelInner(Value: TPanelBevel);
begin
  FPanel.BevelInner := Value;
end;

function TRMPanelControl.GetBevelOuter: TPanelBevel;
begin
  Result := FPanel.BevelOuter;
end;

procedure TRMPanelControl.SetBevelOuter(Value: TPanelBevel);
begin
  FPanel.BevelOuter := Value;
end;

function TRMPanelControl.GetBevelWidth: Integer;
begin
  Result := FPanel.BevelWidth;
end;

procedure TRMPanelControl.SetBevelWidth(Value: Integer);
begin
  FPanel.BevelWidth := Value;
end;

function TRMPanelControl.GetBorderStyle: TBorderStyle;
begin
  Result := FPanel.BorderStyle;
end;

procedure TRMPanelControl.SetBorderStyle(Value: TBorderStyle);
begin
  FPanel.BorderStyle := Value;
end;

function TRMPanelControl.GetBorderWidth: Integer;
begin
  Result := FPanel.BorderWidth;
end;

procedure TRMPanelControl.SetBorderWidth(Value: Integer);
begin
  FPanel.BorderWidth := Value;
end;

function TRMPanelControl.GetCaption: string;
begin
  Result := FPanel.Caption;
end;