rm_dsgctrls.pas

进销存·完整的·有数据库的·非常完整·只得参考

function TRMRuler.IndentToRuler(Indent: Integer; IsRight: Boolean): Integer;
var
  R: TRect;
  P: TPoint;
begin
  Indent := Trunc(Indent * RulerAdj);
  with RichEdit do
  begin
    SendMessage(Handle, EM_GETRECT, 0, Longint(@R));
    if IsRight then
    begin
      P := R.BottomRight;
      P.X := P.X - Indent;
    end
    else
    begin
      P := R.TopLeft;
      P.X := P.X + Indent;
    end;
    P := ClientToScreen(P);
  end;

  P := ScreenToClient(P);
  Result := P.X;
end;

function TRMRuler.RulerToIndent(RulerPos: Integer; IsRight: Boolean): Integer;
var
  R: TRect;
  P: TPoint;
begin
  P.Y := 0; P.X := RulerPos;
  P := ClientToScreen(P);
  with RichEdit do
  begin
    P := ScreenToClient(P);
    SendMessage(Handle, EM_GETRECT, 0, Longint(@R));
    if IsRight then
      Result := R.BottomRight.X - P.X
    else
      Result := P.X - R.TopLeft.X;
  end;
  Result := Trunc(Result / RulerAdj);
end;

procedure TRMRuler.UpdateInd;
begin
  with RichEdit.Paragraph do
  begin
    FirstInd.Left := IndentToRuler(FirstIndent, False) - (FirstInd.Width div 2);
    LeftInd.Left := IndentToRuler(LeftIndent + FirstIndent, False) - (LeftInd.Width div 2);
    RightInd.Left := IndentToRuler(RightIndent, True) - (RightInd.Width div 2);
  end;
end;

procedure TRMRuler.OnRulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragOfs := (TControl(Sender).Width div 2);
  TControl(Sender).Left := Max(0, TControl(Sender).Left + X - FDragOfs);
  FLineDC := GetDCEx(RichEdit.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
    or DCX_LOCKWINDOWUPDATE);
  FLinePen := SelectObject(FLineDC, CreatePen(PS_DOT, 1, ColorToRGB(clWindowText)));
  SetROP2(FLineDC, R2_XORPEN);
  CalcLineOffset(TControl(Sender));
  DrawLine;
  FDragging := True;
end;

procedure TRMRuler.OnRulerItemMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDragging then
  begin
    DrawLine;
    TControl(Sender).Left := Min(Max(0, TControl(Sender).Left + X - FDragOfs),
      ClientWidth - FDragOfs * 2);
    CalcLineOffset(TControl(Sender));
    DrawLine;
  end;
end;

procedure TRMRuler.OnFirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  RichEdit.Paragraph.FirstIndent := Max(0, RulerToIndent(FirstInd.Left + FDragOfs,
    False));
  OnLeftIndMouseUp(Sender, Button, Shift, X, Y);
end;

procedure TRMRuler.OnLeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  if FLineVisible then
    DrawLine;
  DeleteObject(SelectObject(FLineDC, FLinePen));
  ReleaseDC(RichEdit.Handle, FLineDC);
  RichEdit.Paragraph.LeftIndent := Max(-RichEdit.Paragraph.FirstIndent,
    RulerToIndent(LeftInd.Left + FDragOfs, False) -
    RichEdit.Paragraph.FirstIndent);
  if Assigned(FOnIndChanged) then
    FOnIndChanged(RichEdit);
end;

procedure TRMRuler.OnRightIndMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FDragging := False;
  if FLineVisible then
    DrawLine;
  DeleteObject(SelectObject(FLineDC, FLinePen));
  ReleaseDC(RichEdit.Handle, FLineDC);
  RichEdit.Paragraph.RightIndent := Max(0, RulerToIndent(RightInd.Left + FDragOfs,
    True));
  if Assigned(FOnIndChanged) then
    FOnIndChanged(RichEdit);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
type
  TColorEntry = record
    Name: PChar;
    Color: TColor;
  end;

const
  BtnDim = 20;
  AutoOffSet = BtnDim + 2;
  DefaultColors: array[0..39] of TColorEntry = (
    (Name: 'Black'; Color: $000000),
    (Name: 'Brown'; Color: $003399),
    (Name: 'Olive Green'; Color: $003333),
    (Name: 'Dark Green'; Color: $003300),
    (Name: 'Dark Teal'; Color: $663300),
    (Name: 'Dark blue'; Color: $800000),
    (Name: 'Indigo'; Color: $993333),
    (Name: 'Gray-80%'; Color: $333333),

    (Name: 'Dark Red'; Color: $000080),
    (Name: 'Orange'; Color: $0066FF),
    (Name: 'Dark Yellow'; Color: $008080),
    (Name: 'Green'; Color: $008000),
    (Name: 'Teal'; Color: $808000),
    (Name: 'Blue'; Color: $FF0000),
    (Name: 'Blue-Gray'; Color: $996666),
    (Name: 'Gray-50%'; Color: $808080),

    (Name: 'Red'; Color: $0000FF),
    (Name: 'Light Orange'; Color: $0099FF),
    (Name: 'Lime'; Color: $00CC99),
    (Name: 'Sea Green'; Color: $669933),
    (Name: 'Aqua'; Color: $CCCC33),
    (Name: 'Light Blue'; Color: $FF6633),
    (Name: 'Violet'; Color: $800080),
    (Name: 'Grey-40%'; Color: $969696),

    (Name: 'Pink'; Color: $FF00FF),
    (Name: 'Gold'; Color: $00CCFF),
    (Name: 'Yellow'; Color: $00FFFF),
    (Name: 'Bright Green'; Color: $00FF00),
    (Name: 'Turquoise'; Color: $FFFF00),
    (Name: 'Sky Blue'; Color: $FFCC00),
    (Name: 'Plum'; Color: $663399),
    (Name: 'Gray-25%'; Color: $C0C0C0),

    (Name: 'Rose'; Color: $CC99FF),
    (Name: 'Tan'; Color: $99CCFF),
    (Name: 'Light Yellow'; Color: $99FFFF),
    (Name: 'Light Green'; Color: $CCFFCC),
    (Name: 'Light Turquoise'; Color: $FFFFCC),
    (Name: 'Pale Blue'; Color: $FFCC99),
    (Name: 'Lavender'; Color: $FF99CC),
    (Name: 'White'; Color: clWhite)
    );

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMColorButton }

procedure TRMColorButton.Paint;
var
  B, X, Y: integer;
  FColor: TColor;
begin
  inherited;
  if Enabled then
    FColor := Color
  else
    FColor := clGray;
  B := Height div 5;
  with Canvas do
  begin
    if Glyph.Handle <> 0 then
    begin
      X := (Width div 2) - 9 + Integer(FState in [TButtonState(bsDown)]);
      Y := (Height div 2) + 4 + Integer(FState in [TButtonState(bsDown)]);
      Pen.color := FColor;
      Brush.Color := FColor;
      Rectangle(X, Y, X + 17, Y + 4);
    end
    else
    begin
      if Caption = '' then
      begin
        Pen.color := clgray;
        Brush.Color := FColor;
        Brush.Style := bsSolid;
        Rectangle(B, B, Width - B, Height - B);
      end
      else
      begin
        Pen.color := clgray;
        Brush.Style := bsClear;
        Polygon([Point(B - 1, B - 1), Point(Width - (B - 1), B - 1),
          Point(Width - (B - 1), Height - (B - 1)), Point(B - 1, Height - (B - 1))]);
        Pen.color := clgray;
        Brush.Color := FColor;
        Brush.Style := bsSolid;
        Rectangle(B + 1, B + 1, Height, Height - B);
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMColorPicker }

constructor TRMColorPicker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
  if not NewStyleControls then
    ControlStyle := ControlStyle + [csFramed];
  Width := 170;
  Height := BtnDim * 6 + 10 + BtnDim + 6;
  FColorDlg := TColorDialog.Create(self);
  FColorDlg.Options := [cdFullOpen];
  InitButtons;
  FDDIsAuto := true;
  FDDFlat := true;
end;

procedure TRMColorPicker.InitButtons;
var
  I: integer;
  Btn: TRMColorButton;
  ABtn: TSpeedButton;
  X, Y: Integer;
begin
  Btn := TRMColorButton.Create(Self);
  Btn.Parent := Self;
  Btn.Flat := true;
  Btn.Tag := 100;
  Btn.Color := ClDefault;
  Btn.GroupIndex := 1;
  Btn.SetBounds(5, 4, Width - 10, BtnDim);
  Btn.OnClick := BtnClick;
  AutoBtn := Btn;

  for I := 0 to 39 do
  begin
    Btn := TRMColorButton.Create(Self);
    Btn.Parent := Self;
    Btn.Flat := true;
    Btn.Color := DefaultColors[i].Color;
    Btn.Hint := DefaultColors[i].Name;
    Btn.ShowHint := True;
    Btn.GroupIndex := 1;
    Btn.OnClick := BtnClick;
    X := 5 + (I mod 8) * BtnDim;
    Y := BtnDim + 10 + BtnDim * (I div 8);
    Btn.SetBounds(X, Y, BtnDim, BtnDim);
    ColBtns[I] := Btn;
  end;

  Btn := TRMColorButton.Create(Self);
  Btn.Parent := Self;
  Btn.Flat := true;
  Btn.Color := FColorDlg.Color;
  Btn.SetBounds(5, BtnDim * 6 + 10, BtnDim, BtnDim);
  Btn.GroupIndex := 1;
  Btn.OnClick := BtnClick;
  OtherColBtn := Btn;

  ABtn := TSpeedButton.Create(Self);
  ABtn.Parent := Self;
  ABtn.Flat := true;
  ABtn.SetBounds(5 + BtnDim, BtnDim * 6 + 10, Width - 10 - BtnDim, BtnDim);
  OtherBtn := ABtn;
  OtherBtn.OnClick := OtherBtnClick;
end;

procedure TRMColorPicker.OtherBtnClick(Sender: TObject);
begin
  FColorDlg.Color := OtherColBtn.Color;
  TRMColorPickDlg(Owner).FOtherOk := true;
  if FColorDlg.Execute then
    DDSelColor := FColorDlg.Color;
  TRMColorPickDlg(Owner).FOtherOk := False;
  SendMessage(TWinControl(Owner).Handle, WM_KeyDown, vk_return, 0);
end;

procedure TRMColorPicker.BtnClick(Sender: TObject);
begin
  FAutoClicked := (TControl(Sender).Tag = 100);
  DDSelColor := TRMColorButton(Sender).Color;
  SendMessage(TWinControl(Owner).Handle, WM_KeyDown, vk_return, 0);
end;

procedure TRMColorPicker.SetDDAutoColor(Value: TColor);
begin
  if Value <> FDDAutoColor then
  begin
    FDDAutoColor := Value;
    AutoBtn.Color := Value;
  end;
end;

procedure TRMColorPicker.SetDDFlat(Value: Boolean);
var
  i: integer;
begin
  if Value <> FDDFlat then
  begin
    try
      FDDFlat := Value;
      for i := 0 to 39 do
        ColBtns[i].Flat := Value;
      for i := 0 to 15 do
        CustColBtns[i].Flat := Value;
      AutoBtn.Flat := Value;
      OtherBtn.Flat := Value;
      OtherColBtn.Flat := Value;
    except
    end;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMColorPickDlg}

procedure TRMColorPickDlg.Drop(Sender: TControl);
begin
  FSendCtrl := Sender;
  Show;
end;

procedure TRMColorPickDlg.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = vk_escape then
    Close;
  if Key = vk_return then
  begin
    SelectedColor := FColorPick.DDSelColor;
    FCloseOk := true;
    Close;
  end;
  Key := 0;
end;

procedure TRMColorPickDlg.FormShow(Sender: TObject);
var
  i: Integer;
  ok: Boolean;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  FCloseOk := false;
  ok := false;
  for i := 0 to 39 do
  begin
    if DefaultColors[i].Color = SelectedColor then
    begin
      FColorPick.ColBtns[i].down := true;
      Ok := true;
    end;
  end;
  if not Ok then
  begin
    FColorPick.OtherColBtn.Color := SelectedColor;
    FColorPick.OtherColBtn.Down := true;
  end;
end;

procedure TRMColorPickDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FCloseOk then
  begin
    with TRMColorPickerButton(FSendCtrl) do
    begin
      FDrawButton.Color := SelectedColor;
      FCurrentColor := SelectedColor;
      FTargetColor := SelectedColor;
      AutoClicked := FColorPick.AutoClicked;
      Btn1Click(Sender);
    end;
  end;
  Action := caFree;
end;

procedure TRMColorPickDlg.WMKILLFOCUS(var message: TWMKILLFOCUS);
begin
  if not FOtherOk then
    Self.Close;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMColorPickerButton}

constructor TRMColorPickerButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
  if not NewStyleControls then
    ControlStyle := ControlStyle + [csFramed];
  Height := 22;
  BevelOuter := bvNone;
  FFlat := True;
  InitButtons;
  FDDArrowWidth := 12;
  FIsAutomatic := True;
  FCurrentColor := clBlack;
  FDrawButton.NumGlyphs := 2;
  FAutoCaption := RMLoadStr(STransparent);
  FMoreColorsCaption := RMLoadStr(SOther);
end;

procedure TRMColorPickerButton.InitButtons;
begin
  FDrawButton := TRMColorButton.Create(Self);
  FDrawButton.Parent := Self;
  FDrawButton.Flat := FFlat;
  FDrawButton.Color := FCurrentColor;
  FDrawButton.OnClick := Btn1Click;
  FDrawButton.Glyph.Handle := LoadBitmap(HInstance, 'RM_FONTCOLOR');

  FBtnDropDown := TSpeedButton.Create(Self);
  FBtnDropDown.Flat := FFlat;
  FBtnDropDown.Parent := Self;
  FBtnDropDown.Glyph.Handle := LoadBitmap(HInstance, 'RM_DROPDOWN');
  FBtnDropDown.OnClick := BtnDropDownClick;
end;

procedure TRMColorPickerButton.Btn1Click(Sender: TObject);
begin
  if not (csDesigning in ComponentState) and Assigned(FOnBtnClick) then
    FOnBtnClick(Self);
end;

procedure TRMColorPickerButton.BtnDropDownClick(Sender: TObject);
var
  P: TPoint;
  Dlg: TRMColorPickDlg;
begin
  if not (csDesigning in ComponentState) and Assigned(FBeforeDropDown) then
    FBeforeDropDown(Self);
  P.X := TControl(Sender).Left - TControl(Sender).height;
  P.Y := TControl(Sender).Top + TControl(Sender).height;
  P := ClientToScreen(P);