fr_dctrl.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

destructor TfrRadioButtonControl.Destroy;
begin
  FRadioButton.Free;
  inherited Destroy;
end;

procedure TfrRadioButtonControl.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Alignment',
    'taLeftJustify;taRightJustify',
    [taLeftJustify,taRightJustify]);
  AddProperty('Checked', [frdtBoolean], nil);
  AddProperty('Caption', [frdtString], nil);
end;

procedure TfrRadioButtonControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ALIGNMENT' then
    FRadioButton.Alignment := Value
  else if Index = 'CHECKED' then
    FRadioButton.Checked := Value
  else if Index = 'CAPTION' then
    FRadioButton.Caption := Value
end;

function TfrRadioButtonControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ALIGNMENT' then
    Result := FRadioButton.Alignment
  else if Index = 'CHECKED' then
    Result := FRadioButton.Checked
  else if Index = 'CAPTION' then
    Result := FRadioButton.Caption
end;

procedure TfrRadioButtonControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FRadioButton.Alignment := TAlignment(frReadByte(Stream));
  FRadioButton.Checked := frReadBoolean(Stream);
  FRadioButton.Caption := frReadString(Stream);
end;

procedure TfrRadioButtonControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteByte(Stream, Byte(FRadioButton.Alignment));
  frWriteBoolean(Stream, FRadioButton.Checked);
  frWriteString(Stream, FRadioButton.Caption);
end;


{ TfrListBoxControl }

constructor TfrListBoxControl.Create;
begin
  inherited Create;
  FListBox := TListBox.Create(nil);
  FListBox.Parent := frDialogForm;
  AssignControl(FListBox);
  BaseName := 'ListBox';
  dx := 121; dy := 97;
end;

destructor TfrListBoxControl.Destroy;
begin
  FListBox.Free;
  inherited Destroy;
end;

procedure TfrListBoxControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Items', [frdtHasEditor, frdtOneObject], LinesEditor);
  AddProperty('ItemIndex', [], nil);
  AddProperty('Items.Count', [], nil);
end;

procedure TfrListBoxControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ITEMINDEX' then
    FListBox.ItemIndex := Value
end;

function TfrListBoxControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ITEMINDEX' then
    Result := FListBox.ItemIndex
  else if Index = 'ITEMS.COUNT' then
    Result := FListBox.Items.Count
end;

function TfrListBoxControl.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FListBox.Items, MethodName, 'ITEMS', Par1, Par2, Par3);
end;

procedure TfrListBoxControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  frReadMemo(Stream, FListBox.Items);
end;

procedure TfrListBoxControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteMemo(Stream, FListBox.Items);
end;

procedure TfrListBoxControl.LinesEditor(Sender: TObject);
begin
  with TfrLinesEditorForm.Create(nil) do
  begin
    M1.Lines := FListBox.Items;
    if (ShowModal = mrOk) and ((Restrictions and frrfDontModify) = 0) then
    begin
      frDesigner.BeforeChange;
      FListBox.Items := M1.Lines;
      frDesigner.AfterChange;
    end;
    Free;
  end;
end;


{ TfrComboBoxControl }

constructor TfrComboBoxControl.Create;
begin
  inherited Create;
  FComboBox := TComboBox.Create(nil);
  FComboBox.Parent := frDialogForm;
  FComboBox.OnDrawItem := ComboBoxDrawItem;
  FComboBox.OnKeyDown := OnKeyDown;
  AssignControl(FComboBox);
  BaseName := 'ComboBox';
  dx := 145; dy := 21;

  frConsts['csDropDown'] := csDropDown;
  frConsts['csDropDownList'] := csDropDownList;
  frConsts['csLookup'] := csLookup;
end;

destructor TfrComboBoxControl.Destroy;
begin
  FComboBox.Free;
  inherited Destroy;
end;

procedure TfrComboBoxControl.OnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if FComboBox.Style = csDropDownList then
    if (Key = VK_DELETE) or (Key = VK_BACK) then FComboBox.ItemIndex := -1
end;

procedure TfrComboBoxControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Items', [frdtHasEditor, frdtOneObject], LinesEditor);
  AddProperty('ItemIndex', [], nil);
  AddProperty('Items.Count', [], nil);
  AddEnumProperty('Style',
    'csDropDown;csDropDownList;csLookup', [csDropDown,csDropDownList,csLookup]);
  AddProperty('Text', [], nil);
end;

procedure TfrComboBoxControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ITEMINDEX' then
    FComboBox.ItemIndex := Value
  else if Index = 'STYLE' then
    FComboBox.Style := Value
end;

function TfrComboBoxControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ITEMINDEX' then
    Result := FComboBox.ItemIndex
  else if Index = 'STYLE' then
    Result := FComboBox.Style
  else if Index = 'TEXT' then
  begin
    Result := FComboBox.Text;
    if (FComboBox.Style = csOwnerDrawFixed) and (Pos(';', Result) <> 0) then
      Result := Trim(Copy(Result, Pos(';', Result) + 1, 255));
  end
  else if Index = 'ITEMS.COUNT' then
    Result := FComboBox.Items.Count
end;

function TfrComboBoxControl.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FComboBox.Items, MethodName, 'ITEMS', Par1, Par2, Par3);
end;

procedure TfrComboBoxControl.LoadFromStream(Stream: TStream);
var
  b: Byte;
begin
  inherited LoadFromStream(Stream);
  frReadMemo(Stream, FComboBox.Items);
  if HVersion * 10 + LVersion > 10 then
  begin
    b := frReadByte(Stream);
    if (HVersion * 10 + LVersion <= 20) and (b > 0) then
      Inc(b);
    Prop['Style'] := b;
  end;
end;

procedure TfrComboBoxControl.SaveToStream(Stream: TStream);
begin
  LVersion := 1;
  inherited SaveToStream(Stream);
  frWriteMemo(Stream, FComboBox.Items);
  frWriteByte(Stream, Prop['Style']);
end;

procedure TfrComboBoxControl.ComboBoxDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  ComboBox: TComboBox;
  s: String;
begin
  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;

procedure TfrComboBoxControl.LinesEditor(Sender: TObject);
begin
  with TfrLinesEditorForm.Create(nil) do
  begin
    M1.Lines := FComboBox.Items;
    if (ShowModal = mrOk) and ((Restrictions and frrfDontModify) = 0) then
    begin
      frDesigner.BeforeChange;
      FComboBox.Items := M1.Lines;
      frDesigner.AfterChange;
    end;
    Free;
  end;
end;


{$IFDEF DateEdit}

{ TfrDateEditControl }

constructor TfrDateEditControl.Create;
begin
  inherited Create;
{$IFDEF RX}
  FDateEdit := TDateEdit.Create(nil);
  FDateEdit.Parent := frDialogForm;
  FDateEdit.ButtonWidth := 19;
  AssignControl(FDateEdit);
  FDateEdit.OnButtonClick := OnClick;
  BaseName := 'DateEdit';
  dx := 145; dy := 21;

  frConsts['swMon'] := Mon;
  frConsts['swSun'] := Sun;
  frConsts['dyDefault'] := dyDefault;
  frConsts['dyFour'] := dyFour;
  frConsts['dyTwo'] := dyTwo;
{$ELSE}
  FDateEdit := TDateTimePicker.Create(nil);
  FDateEdit.Parent := frDialogForm;
  AssignControl(FDateEdit);
  BaseName := 'DateEdit';
  dx := 145; dy := 21;
  frConsts['dfShort'] := dfShort;
  frConsts['dfLong'] := dfLong;
{$ENDIF}
end;

destructor TfrDateEditControl.Destroy;
begin
  FDateEdit.Free;
  inherited Destroy;
end;

procedure TfrDateEditControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Date', [], nil);
{$IFDEF RX}
  AddEnumProperty('ClickKey', frGetShortCuts, [Null]);
  AddEnumProperty('StartOfWeek', 'swMon;swSun', [Mon,Sun]);
  AddEnumProperty('YearDigits', 'dyDefault;dyFour;dyTwo', [dyDefault,dyFour,dyTwo]);
  AddProperty('Text', [], nil);
{$ELSE}
  AddEnumProperty('DateFormat', 'dfShort;dfLong', [dfShort,dfLong]);
{$ENDIF}
end;

procedure TfrDateEditControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
{$IFDEF RX}
  if Index = 'CLICKKEY' then
    FDateEdit.ClickKey := TextToShortCut(Value)
  else if Index = 'DATE' then
    FDateEdit.Date := Value
  else if Index = 'STARTOFWEEK' then
    FDateEdit.StartOfWeek := Value
  else if Index = 'TEXT' then
    FDateEdit.Text := Value
  else if Index = 'YEARDIGITS' then
    FDateEdit.YearDigits := Value
{$ELSE}
  if Index = 'DATE' then
    FDateEdit.Date := Value
  else if Index = 'DATEFORMAT' then
    FDateEdit.DateFormat := Value;
{$ENDIF}
end;

function TfrDateEditControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
{$IFDEF RX}
  if Index = 'CLICKKEY' then
    Result := ShortCutToText(FDateEdit.ClickKey)
  else if Index = 'DATE' then
    Result := FDateEdit.Date
  else if Index = 'TEXT' then
    Result := FDateEdit.Text
  else if Index = 'STARTOFWEEK' then
    Result := FDateEdit.StartOfWeek
  else if Index = 'YEARDIGITS' then
    Result := FDateEdit.YearDigits
{$ELSE}
  if Index = 'DATE' then
    Result := StrToDate(DateToStr(FDateEdit.Date))
  else if Index = 'DATEFORMAT' then
    Result := FDateEdit.DateFormat;
{$ENDIF}
end;

procedure TfrDateEditControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
{$IFDEF RX}
  Prop['StartOfWeek'] := frReadByte(Stream);
  Prop['YearDigits'] := frReadByte(Stream);
  if HVersion * 10 + LVersion > 10 then
    FDateEdit.ClickKey := frReadByte(Stream);
{$ELSE}
  Prop['DateFormat'] := frReadByte(Stream);
{$ENDIF}
end;

procedure TfrDateEditControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
{$IFDEF RX}
  frWriteByte(Stream, Prop['StartOfWeek']);
  frWriteByte(Stream, Prop['YearDigits']);
  frWriteByte(Stream, FDateEdit.ClickKey);
{$ELSE}
  frWriteByte(Stream, Prop['DateFormat']);
{$ENDIF}
end;
{$ENDIF}


var
  Bmp: Array[0..8] of TBitmap;

initialization
  Bmp[0] := TBitmap.Create;
  Bmp[0].LoadFromResourceName(hInstance, 'FR_LABELCONTROL');
  frRegisterControl(TfrLabelControl, Bmp[0], IntToStr(SInsertLabel));
  Bmp[1] := TBitmap.Create;
  Bmp[1].LoadFromResourceName(hInstance, 'FR_EDITCONTROL');
  frRegisterControl(TfrEditControl, Bmp[1], IntToStr(SInsertEdit));
  Bmp[2] := TBitmap.Create;
  Bmp[2].LoadFromResourceName(hInstance, 'FR_MEMOCONTROL');
  frRegisterControl(TfrMemoControl, Bmp[2], IntToStr(SInsertMemo));
  Bmp[3] := TBitmap.Create;
  Bmp[3].LoadFromResourceName(hInstance, 'FR_BUTTONCONTROL');
  frRegisterControl(TfrButtonControl, Bmp[3], IntToStr(SInsertButton));
  Bmp[4] := TBitmap.Create;
  Bmp[4].LoadFromResourceName(hInstance, 'FR_CHECKBOXCONTROL');
  frRegisterControl(TfrCheckBoxControl, Bmp[4], IntToStr(SInsertCheckBox));
  Bmp[5] := TBitmap.Create;
  Bmp[5].LoadFromResourceName(hInstance, 'FR_RADIOBUTTONCONTROL');
  frRegisterControl(TfrRadioButtonControl, Bmp[5], IntToStr(SInsertRadioButton));
  Bmp[6] := TBitmap.Create;
  Bmp[6].LoadFromResourceName(hInstance, 'FR_LISTBOXCONTROL');
  frRegisterControl(TfrListBoxControl, Bmp[6], IntToStr(SInsertListBox));
  Bmp[7] := TBitmap.Create;
  Bmp[7].LoadFromResourceName(hInstance, 'FR_COMBOBOXCONTROL');
  frRegisterControl(TfrComboBoxControl, Bmp[7], IntToStr(SInsertComboBox));
{$IFDEF DateEdit}
  Bmp[8] := TBitmap.Create;
  Bmp[8].LoadFromResourceName(hInstance, 'FR_DATEEDITCONTROL');
  frRegisterControl(TfrDateEditControl, Bmp[8], IntToStr(SInsertDateEdit));
{$ENDIF}

finalization
  Bmp[0].Free; Bmp[1].Free;
  Bmp[2].Free; Bmp[3].Free;
  Bmp[4].Free; Bmp[5].Free;
  Bmp[6].Free; Bmp[7].Free;
{$IFDEF DateEdit}
  Bmp[8].Free;
{$ENDIF}

end.