fcpropedt.pas

一套及时通讯的原码

begin
  ABitmap := TfcBitmap.Create;
  { 12/7/99 - Remember original RespectPalette settings }
  OrigBitmap:= TfcBitmap(GetOrdValue);
  if OrigBitmap<>nil then
     ABitmap.RespectPalette:= OrigBitmap.RespectPalette;

  if fcExecutePictureEditor(OrigBitmap, ABitmap) then begin
    for i := 0 to PropCount - 1 do begin
       OrigBitmap.assign(ABitmap);   { 12/7/99 - Use assign instead of SetOrdValue }
//       SetOrdValue(Integer(ABitmap));
    end
  end;
  ABitmap.Free;
  Designer.Modified;
end;

function TfcBitmapEditor.GetAttributes: TPropertyAttributes;
begin
  result := [paDialog, paMultiSelect];
end;

function TfcBitmapEditor.GetValue: string;
begin
  if TfcBitmap(GetOrdValueAt(0)).Empty then result := '(None)' else result := '(TfcBitmap)';
end;

function TfcButtonGroupSelectedEditor.GetAttributes: TPropertyAttributes;
begin
  result := [paValueList];
end;

function TfcButtonGroupSelectedEditor.GetValue: string;
begin
  result := '(No Item Selected)';
  with GetComponent(0) as TfcCustomButtonGroup do
    if Selected <> nil then result := Selected.Button.Name;
end;

procedure TfcButtonGroupSelectedEditor.SetValue(const Value: string);
begin
  with GetComponent(0) as TfcCustomButtonGroup do
    Selected := ButtonItems.FindButton(Buttons[Value]);
end;

procedure TfcButtonGroupSelectedEditor.GetValues(Proc: TGetStrProc);
var i: Integer;
begin
  with GetComponent(0) as TfcCustomButtonGroup do
    for i := 0 to ButtonItems.Count - 1 do
      Proc(ButtonItems[i].Button.Name);
end;

procedure TfcCustomOutlookListEditor.Edit;
begin
  fcExecuteCollectionEditor(Component.Name + '.Items', TFormDesigner(Designer), 'Items', TfcCustomOutlookList(Component).Items, nil);
end;

procedure TfcTreeViewItemsProperty.Edit;
begin
  ExecuteTreeNodesEditor(Designer, GetComponent(0) as TfcTreeView);
end;

function TfcTreeViewItemsProperty.GetAttributes: TPropertyAttributes;
begin
   Result:= [paDialog];
end;

function TfcTreeViewItemsProperty.GetValue: string;
begin
   result:= '<TfcTreeNodes>'
end;

procedure TfcTreeViewEditor.Edit;
begin
  ExecuteTreeNodesEditor(Designer, TfcTreeView(Component));
end;

function TfcColorComboSelectedColorEditor.GetAttributes: TPropertyAttributes;
begin
  result := [paValueList, paDialog];
end;

function TfcColorComboSelectedColorEditor.GetValue: string;
begin
  with GetComponent(0) as TfcCustomColorCombo do
    result := SelectedColorString;
end;

procedure TfcColorComboSelectedColorEditor.Edit;
begin
  with GetComponent(0) as TfcCustomColorCombo do
    SelectedColor := fcExecuteColorDialog(SelectedColor);
end;

procedure TfcColorComboSelectedColorEditor.SetValue(const Value: string);
var i: Integer;
begin
  for i := 0 to PropCount - 1 do
    with GetComponent(i) as TfcCustomColorCombo do
      SelectedColorString := Value;
end;

procedure TfcColorComboSelectedColorEditor.GetValues(Proc: TGetStrProc);
var i: Integer;
begin
  with GetComponent(0) as TfcCustomColorCombo do
  begin
    TListbox(ListBox).Sorted := True;
    ListBox.InitColorList;
    for i := 0 to ListBox.AllColors.Count - 1 do
      Proc(ColorString(ListBox.AllColors.Names[i]));
  end;
end;

{ Support null color }
{$ifdef fcDelphi5Up}
procedure TfcImageBtnTrancolorEditor.ListDrawValue(const Value: string; ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
var tempRect: TRect;
  function ColorToBorderColor(AColor: TColor): TColor;
  type
    TColorQuad = record
      Red,
      Green,
      Blue,
      Alpha: Byte;
    end;
  begin
    if (TColorQuad(AColor).Red > 192) or
       (TColorQuad(AColor).Green > 192) or
       (TColorQuad(AColor).Blue > 192) then
      Result := clBlack
    else if ASelected then
      Result := clWhite
    else
      Result := AColor;
  end;
var
  vRight: Integer;
  vOldPenColor, vOldBrushColor: TColor;
begin
  vRight := (ARect.Bottom - ARect.Top) {* 2} + ARect.Left;
  with ACanvas do
  try
    // save off things
    vOldPenColor := Pen.Color;
    vOldBrushColor := Brush.Color;

    // frame things
    Pen.Color := Brush.Color;
    Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);

    // set things up and do the work
    if Value = 'clNullColor' then begin
       Brush.Color := clWhite;
    end
    else
       Brush.Color := StringToColor(Value);
    Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);

    // restore the things we twiddled with
    Brush.Color := vOldBrushColor;
    Pen.Color := vOldPenColor;
  finally
    TempRect:= Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom);
    ACanvas.TextRect(TempRect, TempRect.Left + 1,
       TempRect.Top + 1, Value);
  end;
end;
{$endif}

{$ifdef fcDelphi6Up}
procedure TfcImageBtnTranColorEditor.ListMeasureWidth(const Value: string;
  ACanvas: TCanvas; var AWidth: Integer);
begin
   inherited ListMeasureWidth(Value, ACanvas, AWidth);
end;

procedure TfcImageBtnTranColorEditor.ListMeasureHeight(const Value: string;
  ACanvas: TCanvas; var AHeight: Integer);
begin
  // No implemenation necessary
end;
{$endif}

function TfcImageBtnTranColorEditor.GetValue: string;
begin
  if GetOrdValue = clNullColor then result := 'clNullColor' else result := inherited GetValue;
end;

procedure TfcImageBtnTranColorEditor.SetValue(const Value: string);
begin
  if Value = 'clNullColor' then SetOrdValue(clNullColor)
  else inherited;
end;

procedure TfcImageBtnTranColorEditor.GetValues(Proc: TGetStrProc);
begin
  Proc('clNullColor');
  inherited;
end;

function TfcComponentProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paValueList, paSortList, paRevertable];
end;

function TfcComponentProperty.ValidComponent(AComponent: TComponent): Boolean;
begin
  result := True;
end;

procedure TfcComponentProperty.GetBaseValues(const s: string);
begin
  FStrings.Add(s);
end;

procedure TfcComponentProperty.SetValue(const Value: string);
var CurComponent: TComponent;
begin
  if Value = '' then inherited
  else begin
   {$ifdef fcDelphi6Up}
    CurComponent := Designer.Root.FindComponent(Value);
   {$else}
    CurComponent := Designer.Form.FindComponent(Value);
   {$endif}
    if ValidComponent(CurComponent) then inherited;
  end;
end;

procedure TfcComponentProperty.GetValues(Proc: TGetStrProc);
var i: Integer;
begin
  FStrings := TStringList.Create;
  FStrings.Clear;
  inherited GetValues(GetBaseValues);
  for i := 0 to FStrings.Count - 1 do
   {$ifdef fcDelphi6Up}
    if ValidComponent(Designer.Root.FindComponent(FStrings[i])) then
   {$else}
    if ValidComponent(Designer.Form.FindComponent(FStrings[i])) then
    {$endif}

      Proc(FStrings[i]);
  FStrings.Free;
end;

function TfcImageBtnExtImageEditor.ValidComponent(AComponent: TComponent): Boolean;
var i: Integer;
begin
  result := False;
  for i := 0 to PropCount - 1 do if (AComponent = GetComponent(i)) then Exit;
  result := ((AComponent is TfcCustomImager) or (AComponent is TfcImageBtn));
end;

function TfcOutlookBarActivePageEditor.GetAttributes: TPropertyAttributes;
begin
  result := inherited GetAttributes - [paMultiSelect];
end;

function TfcOutlookBarActivePageEditor.ValidComponent(AComponent: TComponent): Boolean;
begin
  result := (AComponent is TfcCustomBitBtn) and
            ((GetComponent(0) as TfcCustomOutlookBar).OutlookItems.FindButton(AComponent as TfcCustomBitBtn) <> nil)
end;

function TfcCollectionEditor.GetAttributes: TPropertyAttributes;
begin
  result := [paDialog];
end;

function TfcCollectionEditor.GetValue: string;
begin
  result := '(' + GetPropInfo.Name + ')';
end;

procedure TfcCollectionEditor.Edit;
begin
  fcExecuteCollectionEditor(TComponent(GetComponent(0)).Name + GetPropInfo.PropType^.Name, Designer,
    GetPropInfo.PropType^.Name, TfcCollection(GetOrdValue), nil);
end;

function TfcComponentEditor.GetVerbCount: Integer;
begin
  result := 1;
end;

function TfcComponentEditor.GetVerb(Index: Integer): string;
begin
  if Index = GetVerbCount - 1 then result := '&About 1stClass';
end;

procedure TfcComponentEditor.ShowAboutBox;
var fcReg: TRegIniFile;
    ARegNumber: string;
begin
  fcreg := TRegIniFile.create('');
  ARegNumber := fcreg.ReadString('\Software\Woll2Woll\1stClass', 'Reg. No.', '');
  fcreg.Free;
  with TfcAbout1stForm.create(Application) do begin
     AVersion:= fcVersion1stClass;
     ARegistration:= 'Reg. No.: ' + ARegNumber;
     ShowModal;
     Free;
  end
end;

procedure TfcComponentEditor.ExecuteVerb(Index: Integer);
begin
  if Index = GetVerbCount - 1 then ShowAboutBox;
end;


procedure TfcHeaderEditor.Edit;
begin
  ShowCollectionEditor(Designer, Component,
    TfcTreeHeader(Component).Sections, 'Sections');
end;

{
procedure TfcHeaderEditor.ExecuteVerb(Index: Integer);
begin
  ShowCollectionEditor(Designer, Component,
    TfcTreeHeader(Component).Sections, 'Sections');
end;

function TfcHeaderEditor.GetVerb(Index: Integer): string;
begin
  Result := 'Sections Editor';
end;

function TfcHeaderEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;
}

procedure TfcControllerProperty.fcGetStrProc(const s: string);
var Component: TComponent;
begin
  component:= Designer.GetComponent(s);
  if fcIsClass(Component.ClassType, 'TwwController') then
     MyProc(s);
end;

procedure TfcControllerProperty.GetValues(Proc : TGetStrProc);
//var
//  I: Integer;
//  ownerComponent, Component: TComponent;
begin
  MyProc:= Proc;
  Designer.GetComponentNames(GetTypeData(TypeInfo(TComponent)), fcGetStrProc);
end;


end.