ksskinlistboxs.pas

来自「小区水费管理系统源代码水费收费管理系统 水费收费管理系统」· PAS 代码 · 共 481 行

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

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

  All conTeThements 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: KsSkinListBoxs.pas,v 1.3 2002/10/29 02:41:20 Evgeny Exp $

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

unit KsSkinListBoxs;

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, se_controls, KsSkinVersion, KsSkinObjects, KsSkinSource, KsSkinEngine;

type

  TSeSkinListBox = class(TSeCustomListBox)
  private
    FSkinEngine: TSeSkinEngine;
    FSkinListBox: TSeSkinObject;
    FSkinObject: string;
    function GetVersion: TSeSkinVersion;
    procedure SetVersion(const Value: TSeSkinVersion);
    procedure SetSkinEngine(const Value: TSeSkinEngine);
    procedure SetSkinObject(const Value: string);
  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;

    function GetBorderRect: TRect; override;
    procedure PaintBorder; override;

    function CreateScrollBar: TSeCustomScrollBar; override;
    function GetChckBxFieldWidth: integer; override;
    function GetCheckBoxSize: TPoint; override;
    function GetItemHeight(Index: integer): integer; override;

    procedure DrawBackground; override;
    procedure DrawItem(Canvas: TCanvas; Index: integer; ARect: TRect); override;
    procedure DrawCheckBox(Index: integer; ARect: TRect); override;
    { VCL protected  }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  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 KsSkinScrollBars;

{ TSeSkinListBox }

constructor TSeSkinListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSkinObject := 'ListBox';
end;

destructor TSeSkinListBox.Destroy;
begin
  if FSkinListBox<> nil then FSkinListBox.Free;
  inherited;
end;

function TSeSkinListBox.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
       (FSkinListBox <> nil)
    then
      Result := true
    else
      Result := false;
end;

function TSeSkinListBox.CreateScrollBar: TSeCustomScrollBar;
begin
  Result := TSeSkinScrollBar.Create(Self);
  (Result as TSeSkinScrollBar).SkinEngine := FSkinEngine;
end;

function TSeSkinListBox.GetChckBxFieldWidth: integer;
begin
  Result := inherited GetChckBxFieldWidth;
  if UseSkin then
    Result := Result + 6;
end;

function TSeSkinListBox.GetBorderRect: TRect;
var
  SkinObject: TSeSkinObject;
begin
  if UseSkin then
  begin
    SkinObject := FSkinListBox.FindObjectByName('Frame');
    if SkinObject = nil then
      SkinObject := FSkinListBox;

    if SkinObject <> nil then
    begin
      Result.Left := SkinObject.MarginLeft;
      Result.Top := SkinObject.MarginTop;
      Result.Right := FWidth - SkinObject.MarginRight;
      Result.Bottom := FHeight - SkinObject.MarginBottom;
    end;
  end
  else
    Result := inherited GetBorderRect;
end;

function TSeSkinListBox.GetCheckBoxSize: TPoint;
begin
  Result := inherited GetCheckBoxSize;

  if UseSkin then
    Result := Result;
end;

function TSeSkinListBox.GetItemHeight(Index: integer): integer;
begin
  Result := inherited GetItemHeight(Index);
end;

{ Drawing }

procedure TSeSkinListBox.DrawCheckBox(Index: integer; ARect: TRect);
var
  DrawState: TSeState;
  SkinObject: TSeSkinObject;
begin
  if not UseSkin then
  begin
    inherited;
    Exit;
  end;

  if not Enabled then
    DrawState := ssDisabled
  else
    if MouseOnItemIndex = Index then
      DrawState := ssHot
    else
      DrawState := ssNormal;

  case State[Index] of
    cbChecked: SkinObject := FSkinListBox.FindObjectByName('Checked');
    cbGrayed: SkinObject := FSkinListBox.FindObjectByName('Mixed');
  else
    SkinObject := FSkinListBox.FindObjectByName('Unchecked');
  end;

  if SkinObject <> nil then
  begin
    SkinObject.State := DrawState;
    SkinObject.BoundsRect := ARect;
    SkinObject.Draw(Canvas);
  end
  else
    inherited;
end;

procedure TSeSkinListBox.DrawItem(Canvas: TCanvas; Index: integer; ARect: TRect);
var
  DrawState: TSeState;
  SkinObject: TSeSkinObject;
  TmpS: string;
  R, TmpRect: TRect;
  TmpState: TOwnerDrawState;
  Color: Longint;
begin
  if UseSkin then
  begin
    DrawState := ssNormal;

    if not Enabled then
      DrawState := ssDisabled
    else
      if Selected[Index] then
        if Focused then
          DrawState := ssFocused
        else
          DrawState := ssPressed;

    { Set Font }
    if FSkinListBox.FindObjectByName('Item') <> nil then
    begin
      SkinObject := FSkinListBox.FindObjectByName('Item');
      SkinObject.State := DrawState;
      SkinObject.BoundsRect := ARect;
      Canvas.Font := SkinObject.Font;
    end
    else
    begin
      inherited ;
      Exit;
    end;


    TmpRect := ARect;
    Inc(TmpRect.Left, 2);

    if ListStyle in [lbFonts, lbFontSamples, lbColors, lbColorNames] then
    begin
      TmpS := Items[Index];
      { Font and Color }
      case ListStyle of
        lbFonts:
          begin
            { Font Listbox }
            SkinObject.Draw(Canvas);

            if (TrueTypeBmp <> nil) and (Integer(Items.Objects[Index]) and TMPF_TRUETYPE <> 0) then
            begin
              R := Rect(0, 0, TrueTypeBmp.Width, TrueTypeBmp.Height);
              RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + DefaultFontColorHeight, TmpRect.Bottom));
              TrueTypeBmp.Draw(Canvas, R.Left, R.Top, true);
            end;

            Inc(TmpRect.Left, DefaultFontColorHeight + 4);
            DrawText(Canvas, TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE));
          end;
        lbFontSamples:
          begin
            { Font Listbox }
            Canvas.Font.Name := Items[Index];

            SkinObject.Draw(Canvas);

            if (TrueTypeBmp <> nil) and (Integer(Items.Objects[Index]) and TMPF_TRUETYPE <> 0) then
            begin
              R := Rect(0, 0, TrueTypeBmp.Width, TrueTypeBmp.Height);
              RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + DefaultFontColorHeight, TmpRect.Bottom));
              TrueTypeBmp.Draw(Canvas, R.Left, R.Top, true);
            end;

            Inc(TmpRect.Left, DefaultFontColorHeight + 4);
            DrawText(Canvas, TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE));
          end;
        lbColors:
          begin
            { Font Listbox }
            SkinObject.Draw(Canvas);

            { Draw Color Rect }
            InflateRect(TmpRect, -4, -4);
            Color := StringToColor(TmpS);
            FillRect(Canvas, TmpRect, Color);
            DrawRect(Canvas, TmpRect, clBlack);
          end;
        lbColorNames:
          begin
            { Font Listbox }
            SkinObject.Draw(Canvas);

            { Draw Color Rect }
            Color := StringToColor(TmpS);
            R := Rect(0, 0, ColorRectWidth, DefaultFontColorHeight - 4);
            RectCenter(R, Rect(TmpRect.Left, TmpRect.Top, TmpRect.Left + ColorRectWidth, TmpRect.Bottom));
            FillRect(Canvas, R, Color);
            DrawRect(Canvas, R, clBlack);
            { Draw Text}
            if Pos('cl', TmpS) > 0 then
              Delete(TmpS, 1, 2);
            Inc(TmpRect.Left, ColorRectWidth + 4);
            DrawText(Canvas, TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_VCENTER or DT_SINGLELINE));
          end;
      end;

      Exit;
    end;

    if (ListStyle = lbStandard) or (not Assigned(OnDrawItem)) then
    begin
      TmpS := Items[Index];

      if (TmpS = '-') then //separator
      begin
        SkinObject.Text := TmpS;
        SkinObject.State := ssNormal;;
      end
      else
        SkinObject.Text := '';

      SkinObject.Draw(Canvas);

      if (TmpS <> '-') then //separator
        if WordWrap then
          DrawText(Canvas, TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT or DT_WORDBREAK))
        else
          DrawText(Canvas, TmpS, TmpRect, DrawTextBiDiModeFlags(DT_LEFT));
    end
    else
     inherited ;
  end
  else
    inherited ;
end;

procedure TSeSkinListBox.DrawBackground;
var
  DrawState: TSeState;
  SkinObject: TSeSkinObject;
begin
  if UseSkin then
  begin
    if not Enabled then
      DrawState := ssDisabled
    else
      if MouseInControl then
        DrawState := ssHot
      else
        DrawState := ssNormal;

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

    if SkinObject <> nil then
    begin
      SkinObject.State := DrawState;

      if CompareRect(GetBorderRect, Rect(0, 0, Width, Height)) then
        with SkinObject do
          SkinObject.BoundsRect := Classes.Rect(-MarginLeft, -MarginTop, FWidth + MarginRight, FHeight + MarginBottom)
      else
        SkinObject.BoundsRect := Classes.Rect(0, 0, FWidth, FHeight);

      SkinObject.Draw(Canvas);
    end;
  end
  else
    inherited;
end;

procedure TSeSkinListBox.PaintBorder;
var
  SkinObject: TSeSkinObject;
  DrawState: TSeState;
begin
  if UseSkin then
  begin
    if not Enabled then
      DrawState := ssDisabled
    else
      if MouseInControl then
        DrawState := ssHot
      else
        if Focused then
          DrawState := ssFocused
        else
          DrawState := ssNormal;

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

    if SkinObject <> nil then
    begin
      SkinObject.State := DrawState;
      SkinObject.BoundsRect := Rect(0, 0, FWidth, FHeight);
      SkinObject.Draw(Canvas);
    end;
  end
  else
    inherited ;
end;

procedure TSeSkinListBox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSkinEngine) then
    SkinEngine := nil;
end;

procedure TSeSkinListBox.WMBeforeChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  if FSkinListBox <> nil then FSkinListBox.Free;
  FSkinListBox := nil;
end;

procedure TSeSkinListBox.WMSkinChange(var Msg: TMessage);
begin
  if Pointer(Msg.LParam) = nil then Exit;
  if TSeSkinEngine(Msg.LParam) <> FSkinEngine then Exit;

  SkinEngine := FSkinEngine;
end;

procedure TSeSkinListBox.WMInvalidateSkinObject(var Msg: TMessage);
begin
  Invalidate;
end;

{ Properties }

function TSeSkinListBox.GetVersion: TSeSkinVersion;
begin
  Result := sSeSkinVersion;
end;

procedure TSeSkinListBox.SetVersion(const Value: TSeSkinVersion);
begin
end;

procedure TSeSkinListBox.SetSkinEngine(const Value: TSeSkinEngine);
begin
  FSkinEngine := Value;

  if (FSkinEngine <> nil) and (FSkinEngine.SkinSource <> nil) and
     (not FSkinEngine.SkinSource.IsChanging) and
     (FSkinEngine.SkinSource.Count > 0) then
  begin
    if FSkinListBox <> nil then FSkinListBox.Free;
    FSkinListBox := nil;

    if FSkinEngine.SkinSource.GetObjectByName(FSkinObject) <> nil then
      FSkinListBox := FSkinEngine.SkinSource.GetObjectByName(FSkinObject).CreateCopy(nil);

    if FSkinListBox <> nil then
    begin
      FSkinListBox.ParentControl := Self;

      { Change transparent }
      if FSkinListBox.FindObjectByName('Frame') <> nil then
      begin
        if FSkinListBox.FindObjectByName('Frame') is TSeBitmapObject then
          with TSeBitmapObject(FSkinListBox.FindObjectByName('Frame')) do
            Transparent := Masked or MaskedBorder or MaskedAngles
        else
          with FSkinListBox.FindObjectByName('Frame') do
            Transparent := Masked;
      end;
    end;
  end
  else
  begin
    if FSkinListBox <> nil then FSkinListBox.Free;
    FSkinListBox := nil;
  end;

  if FScrlBar <> nil then
    (FScrlBar as TSeSkinScrollBar).SkinEngine := FSkinEngine;

  Invalidate;
end;

procedure TSeSkinListBox.SetSkinObject(const Value: string);
begin
  FSkinObject := Value;
end;

end.