highlightedmemo.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

unit HighlightedMemo;

{ ********************** Nic Hollinworth June 1998 *********************** }

{ The HighLightedMemo component allows you to highlight a line of text within }
{ a memo, using any of the colours available in the current palette.  It will }
{ only highlight the lines which contain text - blank lines are ignored.      }

{ Version 1.3 }

{ I have used a Delphi canvas to paint the highlight colour on the edit window }
{ and also to get the font attributes. This would probably have been faster    }
{ using Windows API functions. This latest version includes a property that    }
{ allows you to invert the colour of the highlighted text if desired.          }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  THighlightedMemo = class(TMemo)
  private
    FHighlightedLine: integer; // Line number of text in memo
    FHighLightColor: TColor;   // HighLight Colour
    FInvertColor: boolean;     // Invert the text within the highlighted bar
    FColIncrement: integer;    // Row offset added when scrolling
    FRowIncrement: integer;    // Col offset added when scrolling
    procedure SetHighLightColor (Value: TColor);
    procedure SetInvertColor (Value: boolean);
    procedure SetLine (LineNumber: integer);
    procedure WMPAINT (var Message: TMessage); message WM_PAINT;
    procedure WMHSCROLL (var Message: TMessage); message WM_HSCROLL;
    procedure WMVSCROLL (var Message: TMessage); message WM_VSCROLL;
  protected
    procedure Change; override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    property HighLightColor: TColor read FHighLightColor write SetHighLightColor default clHighLight;
    property HighLightedLine: integer read FHighLightedLine write SetLine default -1;
    property InvertTextColor: boolean read FInvertColor write SetInvertColor default false;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [THighlightedMemo]);
end;

{ **************************************************************************** }

constructor THighLightedMemo.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FHighlightedLine := -1;
  FHighLightColor  := clHighLight;
  FRowIncrement := 0;
  FInvertColor := false;
end;

{ **************************************************************************** }

procedure THighLightedMemo.Change;
// When the text changes adjust the highlighted line, if
// necessary, and repaint the control.
begin
  inherited Change;
  if HandleAllocated then begin
    FRowIncrement := -GetScrollPos (Handle, SB_VERT);
    FColIncrement := -GetScrollPos (Handle, SB_HORZ);
  end;
  Refresh;
end;

{ **************************************************************************** }

procedure THighlightedMemo.WMPAINT (var Message: TMessage);
// Repaint the control ...
var
  DC: HDC;
  HighLightedRow: integer;
  RowHeight: integer;
  TextString: string;
  TextMargin: integer;
  ThisFont: TFont;
  OldFontColor: TColor;
begin
  inherited;
  // Get a DC for the canvas, and the current font
  DC := GetDC (Handle);
  ThisFont := Font;
  TextString := Lines[FHighLightedLine];
  HighLightedRow := FHighLightedLine + FRowIncrement;

  // Paint the highlighted bar
  if FHighLightedLine >= 0 then begin
    with TCanvas.Create do begin
      Handle := DC;
      Font := ThisFont;

      // Save the existing font color, then invert the colour
      if FInvertColor then begin
        OldFontColor := Font.Color;
        Font.Color := ColorToRGB(FHighLightColor) xor $02FFFFFF // $02 value of high order byte is used to
      end;                                                      // match with nearest colour in logical palette

      RowHeight := TextHeight (TextString);                 // Get the height of the text
      TextMargin := Integer(Perform (EM_GETMARGINS, 0, 0)); // Offset from left edge of client area
      Brush.Color := FHighlightColor;
      FillRect (Rect (0, HighLightedRow*RowHeight, ClientWidth, (HighLightedRow + 1)*RowHeight + 1));
      TextOut (TextMargin + FColIncrement + 1, HighLightedRow*RowHeight + 1, TextString);
      Font.Color := OldFontColor;
      Handle := 0;
      Free; // Free the canvas
    end;
  end;
  // Release the DC when finished
  ReleaseDC(Handle, DC);
end;

{ **************************************************************************** }

procedure THighLightedMemo.SetHighLightColor (Value: TColor);
// Set the colour of the highlighted bar
begin
  FHighLightColor := Value;
  Refresh;
end;

{ **************************************************************************** }

procedure THighLightedMemo.SetLine (LineNumber: integer);
// Set the highlighted bar to the 'LineNumber' given
begin
  FHighLightedLine := LineNumber;
  Refresh;
end;

{ **************************************************************************** }

procedure THighLightedMemo.WMVSCROLL (var Message: TMessage);
// Set the row increment according to the scroll bar position
begin
  inherited;
  FRowIncrement := -GetScrollPos (Handle, SB_VERT);
  Refresh;
end;

{ **************************************************************************** }

procedure THighLightedMemo.WMHSCROLL (var Message: TMessage);
// Set the column increment according to the scroll bar position
begin
  inherited;
  FColIncrement := -GetScrollPos (Handle, SB_HORZ);
  Refresh;
end;

{ **************************************************************************** }

procedure THighLightedMemo.SetInvertColor (Value: boolean);
// Set boolean value to true to invert text colour
begin
  FInvertColor := Value;
  Refresh;
end;

end.