sstyleedits.pas

AlphaControls是一个Delphi标准控件的集合

          end;
          1..4, 6: begin
            if Text = '' then Text := FOwner.FOwner.Name;
          end;
        end;
      end
      else begin
        if Text = '' then Text := FOwner.FOwner.Name;
      end;
{$ELSE}
      if Text = '' then Text := FOwner.FOwner.Name;
{$ENDIF}
      TsLabel(FOwner.FTheLabel).Caption := Text; //| Serge
      FOwner.FTheLabel.Visible := FOwner.FOwner.Visible;
      FOwner.FTheLabel.Enabled := FOwner.FOwner.Enabled;
//      TsLabel(FOwner.FTheLabel).ParentFont := True;
      FOwner.AlignLabel;
    end;
  end
  else begin
    if Active then begin
      if Assigned(FOwner.FTheLabel) then FreeAndNil(FOwner.FTheLabel);
      FActive := False;
    end;
  end;
end;

procedure TsStyleCaption.SetText(const Value: string);
begin
  FText := Value;
  if Active then begin
    TsLabel(FOwner.FTheLabel).Caption := Value;
    FOwner.AlignLabel;
  end;
end;

destructor TsStyleCaption.Destroy;
begin
  FreeAndNil(FFont);
  inherited;
end;

procedure TsStyleCaption.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
  if Active then begin
    TsLabel(FOwner.FTheLabel).Font.Assign(Value);
    FOwner.AlignLabel;
  end;
end;

procedure TsStyleCaption.SetMaxWidth(const Value: integer);
begin
  FMaxWidth := Value;
  if Active then begin
    FOwner.AlignLabel;
  end;
end;

procedure TsStyleCaption.SetLayout(const Value: sConst.TsCaptionLayout);
begin
  FLayout := Value;
  if Active then begin
    FOwner.AlignLabel;
  end;
end;

procedure TsCustomStyle.AlignLabel;
begin
  if Assigned(FTheLabel) and Assigned(FOwner.Parent) then begin
    TsLabel(FTheLabel).AutoSize := True;
    case Caption.Layout of
      sclLeft : begin
        TsLabel(FTheLabel).Alignment := taRightJustify;
        FTheLabel.Left := FOwner.Left - FTheLabel.Width - 4;
        FTheLabel.Top := FOwner.Top -
                         (GetFontHeight(TsLabel(FTheLabel).Font.Handle) - (FOwner.Height - 6)) div 2 +
                         6;
      end;
      sclTopLeft : begin
        TsLabel(FTheLabel).Alignment := taLeftJustify;
        FTheLabel.Left := FOwner.Left;
        FTheLabel.Top := FOwner.Top - GetFontHeight(TsLabel(FTheLabel).Font.Handle) + 5;
      end;
      sclTopCenter : begin
        TsLabel(FTheLabel).Alignment := taCenter;
        FTheLabel.Left := FOwner.Left + (FOwner.Width - FTheLabel.Width) div 2;
        FTheLabel.Top := FOwner.Top - GetFontHeight(TsLabel(FTheLabel).Font.Handle) + 5;
      end;
      sclTopRight : begin
        TsLabel(FTheLabel).Alignment := taRightJustify;
        FTheLabel.Left := FOwner.Left + FOwner.Width - FTheLabel.Width;
        FTheLabel.Top := FOwner.Top - GetFontHeight(TsLabel(FTheLabel).Font.Handle) + 5;
      end;
    end;
    if Caption.FMaxWidth <> 0 then begin
      TsLabel(FTheLabel).AutoSize := False;
      FTheLabel.Width := Caption.FMaxWidth;
      TsLabel(FTheLabel).WordWrap := True;
    end;
    TsLabel(FTheLabel).Transparent := True;
  end;
end;

{$IFDEF USEDB}
{ TsData }

constructor TsData.Create(AOwner: TsStyle);
begin
//  inherited Create;
  FOwner := TsStyle(AOwner);
  Allowing := TsAllowing.Create(AOwner);
end;

destructor TsData.Destroy;
begin
  FreeAndNil(FAllowing);
  inherited;
end;

procedure TsData.SetField(Value: TField);
begin
  if (FField <> Value) and Assigned(Value) then begin
    FField := Value;
//    Allowing.FAutoInit := True;
    case FField.FieldKind of
      fkData: begin
//        Allowing.FInsert := True;
//        Allowing.FUpdate := True;
      end;
      fkCalculated, fkLookup: begin
        Allowing.Insert := False;
        Allowing.Update := False;
      end;
    end;
    Case Value.DataType of
      ftUnknown, ftString, ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
      ftParadoxOle, ftDBaseOle, ftTypedBinary, ftFixedChar, ftWideString,
      ftVariant: begin
        IsNumber := False;
{        if Between(FOwner.COC, COC_TsEdit, COC_TsEdit) and Assigned(Value) then begin
          TsEdit(FOwner).MaxLength := Field.Size;
        end else if Between(FOwner.COC, COC_TsComboEdit, COC_TsComboEdit) and Assigned(Value) then begin
          TsComboEdit(FOwner).MaxLength := Field.Size;
        end
        else
        if Between(FOwner.COC, COC_TsCustomComboBox, COC_TsBDEComboBox) and Assigned(Value) then begin
          TsCustomCombobox(FOwner).MaxLength := Field.Size;
        end;}
      end;
      ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftBCD,
      ftAutoInc, ftLargeint: begin
        IsNumber := True;
      end;
      ftDate, ftTime, ftDateTime : begin
        Self.IsNumber := False;
      end
    end;
  end;
  inherited;
end;
{$ENDIF}

{ TsPainting }

constructor TsPainting.Create(AOwner: TsEditorStyle);
begin
//  inherited Create;
  FBevel := ebAsBottomBorder;
  FColorBorderTop := clBtnHighlight;
  FColorBorderBottom := clBtnShadow;
  FColor := cl3DLight;
  FOwner := TsCustomStyle(AOwner);
  FColorBorderBottom := DefaultColorBottomBorder;
  FColor := DefaultColor;
end;

procedure TsPainting.SetBevel(const Value: TsEditorBevel);
begin
  if FBevel <> Value then begin
    FBevel := Value;
    FOwner.FOwner.Invalidate;
  end;
end;

procedure TsPainting.SetBevelWidth(const Value: integer);
begin
  if FBevelWidth <> Value then begin
    FBevelWidth := Value;
    FOwner.FOwner.Invalidate;
  end;
end;

procedure TsPainting.SetColors(Index: Integer; Value: TColor);
begin
//  Value := ColorToRGB(Value);
  case Index of
    0: FColorBorderTop := Value;
    1: FColorBorderBottom := Value;
    3: begin
      FColor := Value;
      FParentColor := False;
    end;
  end;
  try
    if Assigned(FOwner) and Assigned(FOwner.FOwner) then FOwner.FOwner.Invalidate;
  except
  end;
end;

procedure TsPainting.SetParentColor(Value: Boolean);
begin
  if Value <> FParentColor then begin
    if FOwner.COC in [COC_TsCheckedControl..COC_TsRadioButton] then begin
      FParentColor := True;
      FColor := TsHackedControl(FOwner.FOwner).Color;
      Exit;
    end;
    FParentColor := Value;
    TsHackedControl(FOwner.FOwner).ParentColor := Value;
    if Value then begin
      FColor := TsHackedControl(FOwner.FOwner).Color;
      FOwner.FOwner.invalidate;
    end;
  end;
end;

{ TsStyle }

constructor TsStyle.Create(AOwner: TControl);
begin
  inherited Create(AOwner);
{$IFDEF USEDB}
  FData := TsData.Create(Self);
{$ENDIF}
end;

procedure TsStyle.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..EM_CHANGEALL : begin
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SSTYLE;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
        Message.Result := 1;
        Exit;
      end
      else sStyleMessage(Message);
    end
  end;
  inherited;
end;

procedure TsStyle.sStyleMessage(var Message: TMessage);
begin
  
end;

destructor TsStyle.Destroy;
begin
{$IFDEF USEDB}
  FreeAndNil(FData);
{$ENDIF}
  inherited;
end;

{ TsStyleDB }

procedure TsStyleDB.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    SM_OFFSET..EM_CHANGEALL : begin
      if Message.Msg = SM_GETSTYLEINFO then begin
        TSMGetStyleInfo(Message).WParam := tos_SSTYLEDB;
        TSMGetStyleInfo(Message).LParam := Longint(Self);
        Message.Result := 1;
        Exit;
      end else sStyleMessage(Message);
    end
  end;
  inherited;
end;

procedure TsStyleDB.sStyleMessage(var Message: TMessage);
begin
  inherited;
end;

procedure BeveledBorder(DC: HDC; ColorTop, ColorBottom, Color: TColor; aRect: TRect; Width : integer; Bevel: TsEditorBevel; Soft : boolean);
var
//  i, w : integer;
  R: TRect;
  Color1, Color2 : TColor;
  TopBevel, BottomBevel: TsBorderStyle;
  procedure DrawRect; begin
    // Left line
    BeveledLine(dc, Color1, Color,
                Point(R.Left, R.Bottom - 1),
                Point(R.Left, R.Top),
                Width,
                TopBevel,
                sConst.sdLeft);
    // Top line
    BeveledLine(dc, Color1, Color,
                Point(R.Left, R.Top),
                Point(R.Right, R.Top),
                Width,
                TopBevel,
                sdTop);
    // Right line
    BeveledLine(dc, Color2, Color,
                Point(R.Right - 1, R.Top + 1),
                Point(R.Right - 1, R.Bottom - 1),
                Width,
                BottomBevel,
                sConst.sdRight);
    // Bottom Line
    BeveledLine(dc, Color2, Color,
                Point(R.Right - 1, R.Bottom - 1),
                Point(R.Left, R.Bottom - 1),
                Width,
                BottomBevel,
                sdBottom);
  end;
  procedure DrawRectSharp; begin
    // Left line
    SharpenLine(dc, Color1,
                Point(R.Left, R.Bottom - 1),
                Point(R.Left, R.Top),
                Width,
                TopBevel,
                sConst.sdLeft);
    // Top line
    SharpenLine(dc, Color1,
                Point(R.Left, R.Top),
                Point(R.Right, R.Top),
                Width,
                TopBevel,
                sdTop);
    // Right line
    SharpenLine(dc, Color2,
                Point(R.Right - 1, R.Top + 1),
                Point(R.Right - 1, R.Bottom - 1),
                Width,
                BottomBevel,
                sConst.sdRight);
    // Bottom Line
    SharpenLine(dc, Color2,
                Point(R.Right - 1, R.Bottom - 1),
                Point(R.Left, R.Bottom - 1),
                Width,
                BottomBevel,
                sdBottom);
  end;
begin
  Color1 := ColorTop;
  Color2 := ColorBottom;
  R := aRect;
  Case Bevel of
    ebAsTopBorder : begin
      Color1 := ColorTop;
      Color2 := Color1;
      TopBevel := bsFlat1;
      BottomBevel := bsFlat1;
    end;
    ebAsBottomBorder : begin
      Color1 := ColorBottom;
      Color2 := Color1;
      TopBevel := bsFlat2;
      BottomBevel := bsFlat2;
    end;
    ebRaised: begin
      TopBevel := sConst.bsRaised;
      BottomBevel := sConst.bsLowered;
    end;
    ebLowered: begin
      Color1 := ColorBottom;
      Color2 := ColorTop;
      BottomBevel := sConst.bsRaised;
      TopBevel := sConst.bsLowered;
    end;
  end;
  if not Soft then begin
    DrawRectSharp;
  end
  else begin
    DrawRect;
  end;
end;

end.