rvscroll.pas

richview1.7 full.source

  end;
end;
{------------------------------------------------------------------------------}
function TRVScroller.GetPalette: HPALETTE;
begin
  Result := RVPalette;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.WMQueryNewPalette(var Message: TWMQueryNewPalette);
begin
  inherited;
  Invalidate;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.WMPaletteChanged(var Message: TWMPaletteChanged);
//var DC: HDC;
begin
  inherited;
  {if (Message.PalChg<>Handle) and (RVPalette<>0) then begin
    DC := GetWindowDC(Handle);
    UpdateColors(DC);
    ReleaseDC(Handle, DC);}
    Invalidate;
{  end;}
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.AssignChosenRVData(RVData: TPersistent; Item: TPersistent);
var Editor: TWinControl;
begin
  if RVData<>FChosenRVData then begin
    DestroyInplace;
    UnassignChosenRVData(FChosenRVData);
    FChosenRVData := RVData;
    FChosenItem   := Item;
  end;
  Editor := InplaceEditor;
  if Editor<>nil then
    Editor.Tag := Editor.Top;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SilentReplaceChosenRVData(RVData: TPersistent);
begin
  FChosenRVData := RVData;
  if RVData=nil then
    FChosenItem := nil;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.UnassignChosenRVData(RVData: TPersistent);
begin
  if (RVData=FChosenRVData) or
     ((FChosenRVData<>nil) and (TCustomRVData(FChosenRVData).GetRVData=RVData)) then begin
    if (FChosenRVData<>nil) and not (csDestroying in ComponentState) then
      TCustomRVFormattedData(TCustomRVFormattedData(FChosenRVData).GetRVData).Deselect(nil,False);
    FChosenRVData := nil;
    if FChosenItem<>nil then
      TCustomRVItemInfo(FChosenItem).CleanUpChosen;
    FChosenItem   := nil;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.DestroyInplace;
begin
  InplaceEditor.Free;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  //DestroyInplace;
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.WMSetFocus(var Message: TWMSetFocus);
  function IsDestroying: Boolean;
  var ctrl: TWinControl;
  begin
    Result := False;
    ctrl := Self;
    while (ctrl<>nil) and (ctrl is TRVScroller) do begin
      Result := (csDestroying in ctrl.ComponentState);
      if Result then
        exit;
      ctrl := ctrl.Parent;
    end;
  end;
begin
  inherited;
  if not IsDestroying and (InplaceEditor<>nil) then
    InplaceEditor.SetFocus;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SetVSmallStep(Value: Integer);
begin
  FSmallStep := Value;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SetBiDiModeRV(const Value: TRVBiDiMode);
begin
  if FBiDiMode<>Value then begin
    FBiDiMode := Value;
    RecreateWnd;
  end;
end;
{------------------------------------------------------------------------------}
{$IFDEF RVFLATSCROLLBARS}
procedure TRVScroller.SetScrollBarStyle(const Value: TRVScrollBarStyle);
begin
  if Value<>FScrollBarStyle then begin
    FScrollBarStyle := Value;
    UpdateScrollStyle(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SetScrollBarColor(const Value: TColor);
begin
  if Value<>FScrollBarColor then begin
    FScrollBarColor := Value;
    UpdateScrollColor(True);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.UpdateScrollStyle(Redraw: Boolean);
const
  FSB_FLAT_MODE     = 2;
  FSB_ENCARTA_MODE  = 1;
  FSB_REGULAR_MODE  = 0;
  WSB_PROP_VSTYLE   = $00000100;
  WSB_PROP_HSTYLE   = $00000200;
  Styles: array[TRVScrollBarStyle] of Integer =
  (FSB_REGULAR_MODE, FSB_ENCARTA_MODE, FSB_FLAT_MODE);
begin
  if HandleAllocated and Assigned(RV_SetScrollProp) then begin
    RV_SetScrollProp(Handle, WSB_PROP_HSTYLE, Styles[FScrollBarStyle], Redraw);
    RV_SetScrollProp(Handle, WSB_PROP_VSTYLE, Styles[FScrollBarStyle], Redraw);
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.UpdateScrollColor(Redraw: Boolean);
begin
  if HandleAllocated and Assigned(RV_SetScrollProp) then begin
    RV_SetScrollProp(Handle, WSB_PROP_HBKGCOLOR, ColorToRGB(FScrollBarColor), Redraw);
    RV_SetScrollProp(Handle, WSB_PROP_VBKGCOLOR, ColorToRGB(FScrollBarColor), Redraw);
  end;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWDEF4}
function TRVScroller.DoMouseWheelDown(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  inherited DoMouseWheelDown(Shift, MousePos);
  VScrollPos := VScrollPos+WheelStep;
  Result := WheelStep<>0;
end;
{------------------------------------------------------------------------------}
function TRVScroller.DoMouseWheelUp(Shift: TShiftState;
  MousePos: TPoint): Boolean;
begin
  inherited DoMouseWheelUp(Shift, MousePos);
  VScrollPos := VScrollPos-WheelStep;
  Result := WheelStep<>0;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure InitSB;
{$IFDEF RVFLATSCROLLBARS}
var
  Handle: THandle;
{$ENDIF}
begin
  // Unfortunately, flat scrollbars do not work properly.
  // They are OK in Win2000 + IE5, but when tested in
  // Win95 + IE4, editor window initially always has
  // wrong and not working scroll bars (they become OK
  // after manual resizing of window).
  // I do not know how to defeat it. The problem appears
  // in DISABLENOSCROLL option.

  RV_InitializeFlatSB := nil;
  RV_UninitializeFlatSB := nil;
  RV_SetScrollProp    := nil;
  @RV_ShowScrollBar  := @ShowScrollBar;
  @RV_GetScrollInfo  := @GetScrollInfo;
  @RV_GetScrollPos   := @GetScrollPos;
  @RV_SetScrollPos   := @SetScrollPos;
  @RV_SetScrollInfo  := @SetScrollInfo;
  @RV_EnableScrollBar:= @EnableScrollBar;

  {$IFDEF RVFLATSCROLLBARS}
  Handle := GetModuleHandle('comctl32.dll');
  if Handle <> 0 then
  begin
    @RV_InitializeFlatSB := GetProcAddress(Handle, 'InitializeFlatSB');
    @RV_UninitializeFlatSB := GetProcAddress(Handle, 'UninitializeFlatSB');
    @RV_SetScrollProp := GetProcAddress(Handle, 'FlatSB_SetScrollProp');
    @RV_ShowScrollBar := GetProcAddress(Handle, 'FlatSB_ShowScrollBar');
    if not Assigned(RV_ShowScrollBar) then
      @RV_ShowScrollBar := @ShowScrollBar;
    @RV_GetScrollInfo := GetProcAddress(Handle, 'FlatSB_GetScrollInfo');
    if not Assigned(RV_GetScrollInfo) then
      @RV_GetScrollInfo := @GetScrollInfo;
    @RV_GetScrollPos := GetProcAddress(Handle, 'FlatSB_GetScrollPos');
    if not Assigned(RV_GetScrollPos) then
      @RV_GetScrollPos := @GetScrollPos;
    @RV_SetScrollPos := GetProcAddress(Handle, 'FlatSB_SetScrollPos');
    if not Assigned(RV_SetScrollPos) then
      @RV_SetScrollPos := @SetScrollPos;
    @RV_SetScrollInfo := GetProcAddress(Handle, 'FlatSB_SetScrollInfo');
    if not Assigned(RV_SetScrollInfo) then
      @RV_SetScrollInfo := @SetScrollInfo;
    @RV_EnableScrollBar := GetProcAddress(Handle, 'FlatSB_EnableScrollBar');
    if not Assigned(RV_EnableScrollBar) then
      @RV_EnableScrollBar := @EnableScrollBar;
  end;
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
function TRVScroller.FocusedEx: Boolean;
var Editor: TWinControl;
begin
  Result := False;
  Editor := Self;
  while Editor<>nil do begin
    if Editor.Focused then begin
      Result := True;
      exit;
    end;
    if Editor is TRVScroller then
      Editor := TRVScroller(Editor).InplaceEditor;
  end;
end;
{------------------------------------------------------------------------------}
function TRVScroller.GetInplaceEditor: TWinControl;
begin
  if FChosenRVData=nil then
    Result := nil
  else
    Result := TCustomRVFormattedData(FChosenRVData).GetEditor;
end;
{------------------------------------------------------------------------------}
function TRVScroller.GetChosenRVData: TPersistent;
begin
  if FChosenRVData=nil then
    Result := nil
  else
    Result := TCustomRVData(FChosenRVData).GetRVData;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SetFocusSilent;
{$IFDEF RICHVIEWCBDEF3}
var Form: TCustomForm;
{$ELSE}
var Form: TForm;
{$ENDIF}
begin
  if not CanFocus then
    exit;
  Form := GetParentForm(Self);
  if Form<>nil then begin
    Form.ActiveControl := Self;
  end;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.CreateThemeHandle;
begin
  if UseXPThemes and Assigned(RV_IsAppThemed) and RV_IsAppThemed() and
     RV_IsThemeActive() then
    FTheme := RV_OpenThemeData(Handle, Pointer(PChar(RVWCEDIT)))
  else
    FTheme := 0;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.FreeThemeHandle;
begin
  if FTheme<>0 then
    RV_CloseThemeData(FTheme);
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.WMThemeChanged(var Message: TMessage);
begin
  inherited;
  FreeThemeHandle;
  CreateThemeHandle;
  SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
  RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
  Message.Result := 1;
end;

procedure TRVScroller.WMNCPaint(var Message: TMessage);
var
  DC: HDC;
  RC, RW: TRect;
begin
  if FTheme=0 then begin
    inherited;
    exit;
  end;
  if (BorderStyle = bsSingle) then begin
    DefaultHandler(Message);
    DC := GetWindowDC(Handle);
    try
      Windows.GetClientRect(Handle, RC);
      if GetWindowLong(Handle, GWL_STYLE) and WS_VSCROLL <> 0 then
        if (GetWindowLong(Handle, GWL_EXSTYLE) and WS_EX_LEFTSCROLLBAR)<>0 then
          dec(RC.Left, GetSystemMetrics(SM_CXVSCROLL))
        else
          inc(RC.Right, GetSystemMetrics(SM_CXVSCROLL));
      if GetWindowLong(Handle, GWL_STYLE) and WS_HSCROLL <> 0 then
        inc(RC.Bottom, GetSystemMetrics(SM_CYHSCROLL));
      GetWindowRect(Handle, RW);
      MapWindowPoints(0, Handle, RW, 2);
      OffsetRect(RC, -RW.Left, -RW.Top);
      ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
      OffsetRect(RW, -RW.Left, -RW.Top);
      RV_DrawThemeBackground(FTheme, DC, 0, 0, RW, nil);
      Message.Result := 0;
    finally
      ReleaseDC(Handle, DC);
    end;
    end
  else
    inherited;
end;
{------------------------------------------------------------------------------}
procedure TRVScroller.SetUseXPThemes(const Value: Boolean);
begin
  if FUseXPThemes<>Value then begin
    FUseXPThemes := Value;
    if HandleAllocated then begin
      FreeThemeHandle;
      CreateThemeHandle;
      SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE);
    end;
  end;
end;

procedure TRVScroller.AfterCreateWnd1;
begin
  VPos := 0;
  HPos := 0;
end;

procedure TRVScroller.AfterCreateWnd2;
begin
  UpdateScrollBars(ClientWidth, (ClientHeight div FSmallStep), True, True);
end;

initialization
  InitSB;

end.