rm_dsgctrls.pas

这是一个功能强大

begin
  if GetFontHeight(Font) > FTrueTypeBMP.Height then
    ItemHeight := GetFontHeight(Font)
  else
    ItemHeight := FTrueTypeBMP.Height + 1;
  RecreateWnd;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMTrackIcon}

constructor TRMTrackIcon.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TrackBmp := TBitmap.create;
end;

destructor TRMTrackIcon.Destroy;
begin
  TrackBmp.Free;
  TrackBmp := nil;
  inherited Destroy;
end;

procedure TRMTrackIcon.Paint;
var
  TempRect: TRect;
begin
  Canvas.Lock;
  TempRect := Rect(0, 0, TrackBmp.Width, TrackBmp.Height);
  try
    Canvas.Brush.Style := bsClear;
    Canvas.BrushCopy(TempRect, TrackBmp, TempRect,
      TrackBmp.Canvas.Pixels[0, Height - 1]);
  finally
    Canvas.Unlock;
  end;
end;

procedure TRMTrackIcon.SetBitmapName(const Value: string);
begin
  if FBitmapName <> Value then
  begin
    FBitmapName := Value;
    if Value <> '' then
    begin
      TrackBmp.Handle := LoadBitmap(HInstance, PChar(BitmapName));
      Width := TrackBmp.Width;
      Height := TrackBmp.Height;
    end;
    invalidate;
  end
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMRuler}
const
  rmTwipsPerInch = 1440;

constructor TRMRuler.Create(AOwner: TComponent);
var
  DC: HDC;
begin
  inherited Create(AOwner);
  Parent := TWinControl(AOwner);
  BevelInner := bvNone; //bvLowered;
  BevelOuter := bvNone;
  Caption := '';
  DC := GetDC(0);
  ScreenPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
  ReleaseDC(0, DC);

  FirstInd := TRMTrackIcon.Create(Self);
  with FirstInd do
  begin
    BitmapName := 'RM_RULERDOWN';
    Parent := Self;
    Left := 3;
    Top := 2;
    //    SetBounds(3, 2, 16, 12);
    DragCursor := crArrow;
    OnMouseDown := OnRulerItemMouseDown;
    OnMouseMove := OnRulerItemMouseMove;
    OnMouseUp := OnFirstIndMouseUp;
  end;
  LeftInd := TRMTrackIcon.Create(Self);
  with LeftInd do
  begin
    BitmapName := 'RM_RULERUP';
    Parent := Self;
    Left := 3;
    Top := 12;
    //    SetBounds(3, 12, 16, 12);
    DragCursor := crArrow;
    OnMouseDown := OnRulerItemMouseDown;
    OnMouseMove := OnRulerItemMouseMove;
    OnMouseUp := OnLeftIndMouseUp;
  end;
  RightInd := TRMTrackIcon.Create(Self);
  with RightInd do
  begin
    BitmapName := 'RM_RULERUP';
    Parent := Self;
    Left := 475;
    Top := 13;
    //    SetBounds(475, 13, 15, 12);
    DragCursor := crArrow;
    OnMouseDown := OnRulerItemMouseDown;
    OnMouseMove := OnRulerItemMouseMove;
    OnMouseUp := OnRightIndMouseUp;
  end;
end;

procedure TRMRuler.Paint;
var
  i, j: integer;
  PageWidth: double;
  ScreenPixelsPerUnit: Double;
  liRect: TRect;
begin
  inherited Paint;
  ScreenPixelsPerUnit := ScreenPixelsPerInch;
  liRect := Rect(6, 4, Width - 6, Height - 4);
  with Canvas do
  begin
    Brush.Color := clWhite;
    FillRect(liRect);

    Pen.Color := clBtnShadow;
    MoveTo(liRect.Left - 1, liRect.Bottom);
    LineTo(liRect.Left - 1, liRect.Top);
    LineTo(liRect.Right + 1, liRect.Top);

    Pen.Color := clBlack;
    MoveTo(liRect.Left, liRect.Bottom);
    LineTo(liRect.Left, liRect.Top + 1);
    LineTo(liRect.Right + 1, liRect.Top + 1);

    Pen.Color := clBtnFace;
    MoveTo(liRect.Left - 1, liRect.Bottom);
    LineTo(liRect.Right + 1, liRect.Bottom);
    LineTo(liRect.Right + 1, liRect.Top);

    Pen.Color := clBtnHighlight;
    MoveTo(liRect.Left - 1, liRect.Bottom + 1);
    LineTo(liRect.Right + 2, liRect.Bottom + 1);
    LineTo(liRect.Right + 2, liRect.Top);

    PageWidth := (RichEdit.Width - 12) / ScreenPixelsPerUnit;
    for i := 0 to trunc(pageWidth) + 1 do
    begin
      if (i >= PageWidth) then
        continue;
      if i > 0 then
        TextOut(Trunc(liRect.Left + i * ScreenPixelsPerUnit - TextWidth(inttostr(i)) div 2),
          liRect.Top + 3, inttostr(i));
      for j := 1 to 3 do
      begin
        Pen.color := clBlack;
        if (i + j / 4 >= PageWidth) then
          Continue;

        if (j = 4 div 2) then
        begin
          MoveTo(liRect.Left + Trunc((i + (j / 4)) * ScreenPixelsPerUnit), liRect.Top + 7);
          LineTo(liRect.Left + Trunc((i + (j / 4)) * ScreenPixelsPerUnit), liRect.Bottom - 5);
        end
        else
        begin
          MoveTo(liRect.Left + Trunc((i + (j / 4)) * ScreenPixelsPerUnit), liRect.Top + 8);
          LineTo(liRect.Left + Trunc((i + (j / 4)) * ScreenPixelsPerUnit), liRect.Bottom - 7);
        end
      end
    end;
  end;
end;

procedure TRMRuler.DrawLine;
var
  P: TPoint;
begin
  FLineVisible := not FLineVisible;
  P := Point(0, 0);
  Inc(P.X, FLineOfs);
  with P, RichEdit do
  begin
    MoveToEx(FLineDC, X, Y, nil);
    LineTo(FLineDC, X, Y + ClientHeight);
  end;
end;

procedure TRMRuler.CalcLineOffset(Control: TControl);
var
  P: TPoint;
begin
  with Control do
    P := ClientToScreen(Point(0, 0));
  P := RichEdit.ScreenToClient(P);
  FLineOfs := P.X + FDragOfs;
end;

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
  if RichEdit.Paragraph = nil then Exit;
  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;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMTabControl }

function TRMTabControl.GetTabsCaption(Index: Integer): string;
begin
{$IFDEF Raize}
  Result := Tabs[Index].Caption;
{$ELSE}
  Result := Tabs[Index];
{$ENDIF}
end;

procedure TRMTabControl.SetTabsCaption(Index: Integer; Value: string);
begin
{$IFDEF Raize}
  Tabs[Index].Caption := Value;
{$ELSE}
  Tabs[Index] := Value;
{$ENDIF}
end;

constructor TRMTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF JVCLCTLS}
  //Style := tsFlatButtons;
{$ENDIF}
end;

function TRMTabControl.AddTab(const S: string): Integer;
begin
{$IFDEF Raize}
  Tabs.Add.Caption := S;
  Result := Tabs.Count;
{$ELSE}
  Result := Tabs.Add(S);
{$ENDIF}
end;

{$IFDEF Raize}

function TRMPanel.GetBevelInner: TPanelBevel;
begin
  Result := bvNone;
end;

function TRMPanel.GetBevelOuter: TPanelBevel;
begin
  Result := bvNone;
end;

procedure TRMPanel.SetBevelInner(const Value: TPanelBevel);
begin
  case Value of
    bvNone: BorderInner := fsNone;
    bvLowered: BorderInner := fsLowered;
    bvRaised: BorderInner := fsRaised;
    bvSpace: BorderInner := fsFlat;
  end;
end;

procedure TRMPanel.SetBevelOuter(const Value: TPanelBevel);
begin
  case Value of
    bvNone: BorderOuter := fsNone;
    bvLowered: BorderOuter := fsLowered;
    bvRaised: BorderOuter := fsRaised;
    bvSpace: BorderOuter := fsFlat;
  end;
end;
{$ENDIF}

{$IFDEF FlatStyle}

function TRMTabControl.GetOnChange: TNotifyEvent;
begin
  Result := OnTabChanged;
end;

procedure TRMTabControl.SetOnChange(const Value: TNotifyEvent);
begin
  OnTabChanged := Value;
end;

function TRMTabControl.GetTabIndex: Integer;
begin
  Result := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
end;

procedure TRMTabControl.SetTabIndex(const Value: Integer);
begin
  SendMessage(Handle, TCM_SETCURSEL, Value, 0);
end;

procedure TRMTabControl.SetMultiLine(Value: Boolean);
begin
  FMultiLine := value;
end;
{$ENDIF}
//dejoy added end

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}

constructor TRMFrameStyleButton.Create(aOwner: TComponent);
begin
  inherited;

  FPopup := nil;
end;

destructor TRMFrameStyleButton.Destroy;
begin
  FreeAndNil(FPopup);
  inherited;
end;

function TRMFrameStyleButton.GetDropDownPanel: TRMPopupWindow;
var
  tmp: TSpeedButton;
  i: Integer;
begin
  if FPopup <> nil then
  begin
    Result := FPopup;
    Exit;
  end;

  FPopup := TRMPopupWindow.CreateNew(nil);
  FPopup.Font.Assign(Font);
  FPopup.ClientWidth := 90 + 4 + 4;
  FPopup.ClientHeight := 18 * 6 + 2 + 2;
  for i := 1 to 6 do
  begin
    tmp := TSpeedButton.Create(FPopup);
    tmp.Flat := True;
    tmp.Parent := FPopup;
    tmp.Tag := 24 + i;
    tmp.GroupIndex := 1;
    tmp.Glyph.LoadFromResourceName(hInstance, 'RM_BORDERSTYLE' + IntToStr(i));
    tmp.SetBounds(4, 2 + 18 * (i - 1), 90, 18);
    tmp.OnClick := Item_OnClick;
  end;

  DropdownPanel := FPopup;
  Result := FPopup;
end;

procedure TRMFrameStyleButton.Item_OnClick(Sender: TObject);
begin
  FCurrentStyle := TRMToolbarButton(Sender).Tag;
  FPopup.Close(nil);

  if Assigned(FOnStyleChange) then FOnStyleChange(Sender);
end;

procedure TRMFrameStyleButton.SetCurrentStyle(Value: Integer);
begin
  FCurrentStyle := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMNewScrollBox }

constructor TRMNewScrollBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TabStop := True; //使之能获得焦点
end;

procedure TRMNewScrollBox.CNKeydown(var Message: TMessage);
begin
  case TWMKey(Message).CharCode of
    VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_TAB:
      begin
        Exit; //如果让他自己处理的话就会失去焦点，必须中断才能把消息传到WM_KeyDown
      end;
  else
    inherited;
  end;
end;

procedure TRMNewScrollBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Assigned(FOnkeyDown) then
  begin
    FOnkeyDown(Self, key, Shift);
  end;
  inherited;
end;

end.