ksskindbgrids.pas

小区水费管理系统源代码水费收费管理系统 水费收费管理系统

{==============================================================================

  SkinEngine's DBGrid
  Copyright (C) 2000-2002 by Evgeny Kryukov
  All rights reserved

  All conTeSkinnts of this file and all other files included in this archive
  are Copyright (C) 2002 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

  $Id: KsSkinDBGrids.pas,v 1.3 2002/08/13 08:02:20 Evgeny Exp $

===============================================================================}

unit KsSkinDBGrids;

{$I se_define.inc}
{$T-,W-,X+,P+}

interface

uses Windows, SysUtils, Messages, Classes, Controls, Forms, Graphics, Menus,
   StdCtrls, ExtCtrls, Buttons, ComCtrls, Grids, DB, DBCtrls, DBGrids, ImgList,
   se_controls, KsSkinEngine, KsSkinVersion, KsSkinScrollBars, KsSkinObjects;

type

{ TSeSkinDBGrid class }

  TSeSkinDBGrid = class(TDBGrid)
  private
    FIndicators: TImageList;
    FTitleOffset: Byte;
    FSelRow: Integer;
    FSubScrollBars: TSeSubScrollBar;
    FSkinEngine: TSeSkinEngine;
    FSkinGrid: TSeSkinObject;
    FSkinObject: string;
    function GetVersion: TSeSkinVersion;
    procedure SetSkinEngine(const Value: TSeSkinEngine);
    procedure SetVersion(const Value: TSeSkinVersion);
    procedure SetSkinObject(const Value: string);
    procedure MyDrawCell(ACol, ARow: Integer; ARect: TRect;
      AState: TGridDrawState);
  protected
    procedure WMInvalidateSkinObject(var Msg: TMessage); message WM_INVALIDATESKINOBJECT;
    procedure WMBeforeChange(var Msg: TMessage); message WM_BEFORECHANGE;
    procedure WMSkinChange(var Msg: TMessage); message WM_SKINCHANGE;

    function UseSkin: boolean;
    { KSDev's ScrollBar subclassing }
    procedure WndProc(var Message: TMessage); override;
    procedure SetParent(AParent: TWinControl); override;
    procedure CreateScrollBar(var AScrollBar: TSeCustomScrollBar; AOwner: TComponent); virtual;
    { KSDev's Paint }
    procedure PaintBorder(Canvas: TCanvas; ARect: TRect); virtual;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    { Grids }
    property SubScrollBars: TSeSubScrollBar read FSubScrollBars;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property SkinEngine: TSeSkinEngine read FSkinEngine write SetSkinEngine;
    property SkinObject: string read FSkinObject write SetSkinObject;
    property Version: TSeSkinVersion read GetVersion write SetVersion
      stored false;
  end;

implementation {===============================================================}

uses se_winxp, Math;

{$R *.res}

const
  bmArrow = 'SE_DBGARROW';
  bmEdit = 'SE_DBEDIT';
  bmInsert = 'SE_DBINSERT';
  bmMultiDot = 'SE_DBMULTIDOT';
  bmMultiArrow = 'SE_DBMULTIARROW';

var
  DrawBitmap: TBitmap;
  UserCount: Integer;

procedure UsesBitmap;
begin
  if UserCount = 0 then
    DrawBitmap := TBitmap.Create;
  Inc(UserCount);
end;

procedure ReleaseBitmap;
begin
  Dec(UserCount);
  if UserCount = 0 then DrawBitmap.Free;
end;

procedure WriteText(ACanvas: TCanvas; ARect: TRect; DX, DY: Integer;
  const Text: string; Alignment: TAlignment; ARightToLeft: Boolean);
const
  AlignFlags : array [TAlignment] of Integer =
    ( DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
      DT_RIGHT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX,
      DT_CENTER or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX );
  RTL: array [Boolean] of Integer = (0, DT_RTLREADING);
var
  B, R: TRect;
  Hold, Left: Integer;
  I: TColorRef;
begin
  I := ColorToRGB(ACanvas.Brush.Color);
  if GetNearestColor(ACanvas.Handle, I) = I then
  begin                       { Use ExtTextOut for solid colors }
    { In BiDi, because we changed the window origin, the text that does not
      change alignment, actually gets its alignment changed. }
    if (ACanvas.CanvasOrientation = coRightToLeft) and (not ARightToLeft) then
      ChangeBiDiModeAlignment(Alignment);
    case Alignment of
      taLeftJustify:
        Left := ARect.Left + DX;
      taRightJustify:
        Left := ARect.Right - ACanvas.TextWidth(Text) - 3;
    else { taCenter }
      Left := ARect.Left + (ARect.Right - ARect.Left) shr 1
        - (ACanvas.TextWidth(Text) shr 1);
    end;
    ACanvas.TextRect(ARect, Left, ARect.Top + DY, Text);
  end
  else begin                  { Use FillRect and Drawtext for dithered colors }
    DrawBitmap.Canvas.Lock;
    try
      with DrawBitmap, ARect do { Use offscreen bitmap to eliminate flicker and }
      begin                     { brush origin tics in painting / scrolling.    }
        Width := Max(Width, Right - Left);
        Height := Max(Height, Bottom - Top);
        R := Rect(DX, DY, Right - Left - 1, Bottom - Top - 1);
        B := Rect(0, 0, Right - Left, Bottom - Top);
      end;
      with DrawBitmap.Canvas do
      begin
        Font := ACanvas.Font;
        Font.Color := ACanvas.Font.Color;
        Brush := ACanvas.Brush;
        Brush.Style := bsSolid;
        FillRect(B);
        SetBkMode(Handle, TRANSPARENT);
        if (ACanvas.CanvasOrientation = coRightToLeft) then
          ChangeBiDiModeAlignment(Alignment);
        Windows.DrawText(Handle, PChar(Text), Length(Text), R,
          AlignFlags[Alignment] or RTL[ARightToLeft]);
      end;
      if (ACanvas.CanvasOrientation = coRightToLeft) then  
      begin
        Hold := ARect.Left;
        ARect.Left := ARect.Right;
        ARect.Right := Hold;
      end;
      ACanvas.CopyRect(ARect, DrawBitmap.Canvas, B);
    finally
      DrawBitmap.Canvas.Unlock;
    end;
  end;
end;


{ TSeSkinDBGrid ===============================================================}

constructor TSeSkinDBGrid.Create(AOwner: TComponent);
var
  Bmp: TBitmap;
begin
  inherited Create(AOwner);
  FSkinObject := 'Grid';
  { Sub class scrollbars }
  FSubScrollBars := TSeSubScrollBar.Create(Self, CreateScrollBar);

  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromResourceName(HInstance, bmArrow);
    FIndicators := TImageList.CreateSize(Bmp.Width, Bmp.Height);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmEdit);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmInsert);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmMultiDot);
    FIndicators.AddMasked(Bmp, clWhite);
    Bmp.LoadFromResourceName(HInstance, bmMultiArrow);
    FIndicators.AddMasked(Bmp, clWhite);
  finally
    Bmp.Free;
  end;

  FTitleOffset := 1;
end;

destructor TSeSkinDBGrid.Destroy;
begin
  FSubScrollBars.Control := nil;
  FSubScrollBars.Free;
  if FSkinGrid <> nil then FSkinGrid.Free;
  FIndicators.Free;
  inherited Destroy;
end;

function TSeSkinDBGrid.UseSkin: boolean;
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then
    Result := false
  else
    if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
       (not FSkinEngine.SkinSource.IsChanging) and
       (FSkinEngine.SkinSource.Count > 0) and
       (FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil) and
       (FSkinGrid <> nil)
    then
      Result := true
    else
      Result := false;
end;

procedure TSeSkinDBGrid.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FSubScrollBars <> nil then FSubScrollBars.SetParent(AParent);
end;

procedure TSeSkinDBGrid.CreateScrollBar(var AScrollBar: TSeCustomScrollBar; AOwner: TComponent);
begin
  AScrollBar := TSeSkinScrollBar.Create(AOwner);
end;

procedure TSeSkinDBGrid.WndProc(var Message: TMessage);
var
  Canvas: TCanvas;
  R: TRect;
begin
  if FSubScrollBars <> nil then FSubScrollBars.SubWndProc(Message);

  case Message.Msg of
    WM_NCPAINT:
      begin
        GetWindowRect(Handle, R);
        OffsetRect(R, -R.Left, -R.Top);

        if BorderStyle = bsNone then
          InflateRect(R, 2, 2);

        Canvas := TCanvas.Create;
        Canvas.Handle := GetWindowDC(Handle);

        ExcludeClipRect(Canvas.Handle, R.Left + 2, R.Top + 2, R.Left + 2 + ClientWidth, R.Top + 2 + ClientHeight);

        PaintBorder(Canvas, R);

        Canvas.Handle := 0;
        Canvas.Free;

        Message.Result := 0;
      end;
  else
    inherited ;
  end;
end;

procedure TSeSkinDBGrid.PaintBorder(Canvas: TCanvas; ARect: TRect);
var
  SkinObject: TSeSkinObject;
  DrawState: TSeState;
  Theme: HTheme;
  Part, ThemeState: integer;
begin
  if UseSkin then
  begin
    if not Enabled then
      DrawState := ssDisabled
    else
      DrawState := ssNormal;

    SkinObject := FSkinGrid.FindObjectByName('Frame');

    if SkinObject <> nil then
    begin
      SkinObject.State := DrawState;
      SkinObject.BoundsRect := ARect;
      SkinObject.Draw(Canvas);
    end;
  end
  else
  begin
    if UseThemes then
    begin
      Theme := OpenThemeData(0, 'Edit');
      Part := integer(EP_EDITText);

      if not Enabled then
        ThemeState := integer(ETS_DISABLED)
      else