fr_dctrl.pas

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

procedure TfrStdControl.OnClickEditor(Sender: TObject);
begin
  ShowEditor;
end;

procedure TfrStdControl.OnClick(Sender: TObject);
var
  sl, sl1: TStringList;
begin
  if DocMode = dmDesigning then Exit;
  CurView := Self;
  sl := TStringList.Create;
  sl1 := TStringList.Create;
  frInterpretator.PrepareScript(Script, sl, sl1);
  frInterpretator.DoScript(sl);
  sl.Free;
  sl1.Free;
end;

procedure TfrStdControl.AssignControl(AControl: TControl);
begin
  FControl := AControl;
  THackControl(Control).OnClick := OnClick;
end;


{ TfrLabelControl }

constructor TfrLabelControl.Create;
begin
  inherited Create;
  FLabel := TLabel.Create(nil);
  FLabel.Parent := frDialogForm;
  FLabel.Caption := 'Label';
  AssignControl(FLabel);
  BaseName := 'Label';

  frConsts['taLeftJustify'] := taLeftJustify;
  frConsts['taRightJustify'] := taRightJustify;
  frConsts['taCenter'] := taCenter;
end;

destructor TfrLabelControl.Destroy;
begin
  FLabel.Free;
  inherited Destroy;
end;

procedure TfrLabelControl.DefineProperties;
begin
  inherited DefineProperties;
  AddEnumProperty('Alignment',
    'taLeftJustify;taRightJustify;taCenter',
    [taLeftJustify,taRightJustify,taCenter]);
  AddProperty('AutoSize', [frdtBoolean], nil);
  AddProperty('Caption', [frdtString], nil);
  AddProperty('WordWrap', [frdtBoolean], nil);
end;

procedure TfrLabelControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'ALIGNMENT' then
    FLabel.Alignment := Value
  else if Index = 'AUTOSIZE' then
    FLabel.AutoSize := Value
  else if Index = 'CAPTION' then
    FLabel.Caption := Value
  else if Index = 'WORDWRAP' then
    FLabel.WordWrap := Value
end;

function TfrLabelControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ALIGNMENT' then
    Result := FLabel.Alignment
  else if Index = 'AUTOSIZE' then
    Result := FLabel.AutoSize
  else if Index = 'CAPTION' then
    Result := FLabel.Caption
  else if Index = 'WORDWRAP' then
    Result := FLabel.WordWrap
end;

procedure TfrLabelControl.Draw(Canvas: TCanvas);
begin
  BeginDraw(Canvas);
  if Prop['AutoSize'] = True then
  begin
    dx := FLabel.Width;
    dy := FLabel.Height;
  end
  else
  begin
    FLabel.Width := dx;
    FLabel.Height := dy;
  end;
  CalcGaps;
  PaintDesignControl;
  RestoreCoord;
end;

procedure TfrLabelControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FLabel.Alignment := TAlignment(frReadByte(Stream));
  FLabel.AutoSize := frReadBoolean(Stream);
  FLabel.Caption := frReadString(Stream);
  FLabel.WordWrap := frReadBoolean(Stream);
  if Prop['AutoSize'] = True then
  begin
    dx := FLabel.Width;
    dy := FLabel.Height;
  end;
end;

procedure TfrLabelControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteByte(Stream, Byte(FLabel.Alignment));
  frWriteBoolean(Stream, FLabel.AutoSize);
  frWriteString(Stream, FLabel.Caption);
  frWriteBoolean(Stream, FLabel.WordWrap);
end;


{ TfrEditControl }

constructor TfrEditControl.Create;
begin
  inherited Create;
  FEdit := TEdit.Create(nil);
  FEdit.Parent := frDialogForm;
  FEdit.Text := 'Edit';
  AssignControl(FEdit);
  BaseName := 'Edit';
  dx := 121; dy := 21;
end;

destructor TfrEditControl.Destroy;
begin
  FEdit.Free;
  inherited Destroy;
end;

procedure TfrEditControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Text', [frdtString], nil);
  AddProperty('ReadOnly', [frdtBoolean], nil);
end;

procedure TfrEditControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'TEXT' then
    FEdit.Text := Value
  else if Index = 'READONLY' then
    FEdit.ReadOnly := Value
end;

function TfrEditControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'TEXT' then
    Result := FEdit.Text
  else if Index = 'READONLY' then
    Result := FEdit.ReadOnly
end;

procedure TfrEditControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FEdit.Text := frReadString(Stream);
  FEdit.ReadOnly := frReadBoolean(Stream);
end;

procedure TfrEditControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteString(Stream, FEdit.Text);
  frWriteBoolean(Stream, FEdit.ReadOnly);
end;


{ TfrMemoControl }

constructor TfrMemoControl.Create;
begin
  inherited Create;
  FMemo := TMemo.Create(nil);
  FMemo.Parent := frDialogForm;
  FMemo.Text := 'Memo';
  AssignControl(FMemo);
  BaseName := 'Memo';
  dx := 185; dy := 89;
end;

destructor TfrMemoControl.Destroy;
begin
  FMemo.Free;
  inherited Destroy;
end;

procedure TfrMemoControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Lines', [frdtHasEditor, frdtOneObject], LinesEditor);
  AddProperty('Lines.Count', [], nil);
  AddProperty('ReadOnly', [frdtBoolean], nil);
  AddProperty('Text', [], nil);
end;

procedure TfrMemoControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'READONLY' then
    FMemo.ReadOnly := Value
  else if Index = 'TEXT' then
    FMemo.Text := Value
end;

function TfrMemoControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'READONLY' then
    Result := FMemo.ReadOnly
  else if Index = 'LINES.COUNT' then
    Result := FMemo.Lines.Count
  else if Index = 'TEXT' then
    Result := FMemo.Text
end;

function TfrMemoControl.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FMemo.Lines, MethodName, 'LINES', Par1, Par2, Par3);
end;

procedure TfrMemoControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FMemo.Text := frReadString(Stream);
  FMemo.ReadOnly := frReadBoolean(Stream);
end;

procedure TfrMemoControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteString(Stream, FMemo.Text);
  frWriteBoolean(Stream, FMemo.ReadOnly);
end;

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


{ TfrButtonControl }

constructor TfrButtonControl.Create;
begin
  inherited Create;
  FButton := TButton.Create(nil);
  FButton.Parent := frDialogForm;
  FButton.Caption := 'Button';
  AssignControl(FButton);
  BaseName := 'Button';
  dx := 75; dy := 25;
end;

destructor TfrButtonControl.Destroy;
begin
  FButton.Free;
  inherited Destroy;
end;

procedure TfrButtonControl.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Cancel', [], nil);
  AddProperty('Caption', [frdtString], nil);
  AddProperty('Default', [], nil);
  AddEnumProperty('ModalResult',
    'mrNone;mrOk;mrCancel',
    [mrNone,mrOk,mrCancel]);
end;

procedure TfrButtonControl.SetPropValue(Index: String; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'CAPTION' then
    FButton.Caption := Value
  else if Index = 'MODALRESULT' then
  begin
    FButton.ModalResult := Value;
    FButton.Cancel := FButton.ModalResult = mrCancel;
    FButton.Default := FButton.ModalResult = mrOk;
  end
  else if Index = 'CANCEL' then
    FButton.Cancel := Value
  else if Index = 'DEFAULT' then
    FButton.Default := Value
end;

function TfrButtonControl.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'CAPTION' then
    Result := FButton.Caption
  else if Index = 'MODALRESULT' then
    Result := FButton.ModalResult
  else if Index = 'CANCEL' then
    Result := FButton.Cancel
  else if Index = 'DEFAULT' then
    Result := FButton.Default
end;

procedure TfrButtonControl.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FButton.Caption := frReadString(Stream);
  FButton.ModalResult := frReadWord(Stream);
  FButton.Cancel := FButton.ModalResult = mrCancel;
  FButton.Default := FButton.ModalResult = mrOk;
end;

procedure TfrButtonControl.SaveToStream(Stream: TStream);
begin
  inherited SaveToStream(Stream);
  frWriteString(Stream, FButton.Caption);
  frWriteWord(Stream, FButton.ModalResult);
end;


{ TfrCheckBoxControl }

constructor TfrCheckBoxControl.Create;
begin
  inherited Create;
  FCheckBox := TCheckBox.Create(nil);
  FCheckBox.Parent := frDialogForm;
  FCheckBox.Caption := 'CheckBox';
  AssignControl(FCheckBox);
  BaseName := 'CheckBox';
  dx := 97; dy := 17;
end;

destructor TfrCheckBoxControl.Destroy;
begin
  FCheckBox.Free;
  inherited Destroy;
end;

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

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

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

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

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


{ TfrRadioButtonControl }

constructor TfrRadioButtonControl.Create;
begin
  inherited Create;
  FRadioButton := TRadioButton.Create(nil);
  FRadioButton.Parent := frDialogForm;
  FRadioButton.Caption := 'RadioButton';
  AssignControl(FRadioButton);
  BaseName := 'RadioButton';
  dx := 113; dy := 17;
end;