tsimagelisteditor.pas

企业进销存管理系统

{*******************************************************}
{                                                       }
{       Top Support Visual Components                   }
{       TopGrid TtsImageList component editor           }
{                                                       }
{       Copyright (c) 1999, Top Support                 }
{                                                       }
{*******************************************************}

unit TSImagelistEditor;

{$INCLUDE TSCmpVer}

interface

uses
    TSImageList,
    {$IFDEF TSVER_V6}
       Variants, DesignIntf, DesignEditors,
    {$ELSE}
       DsgnIntf,
    {$ENDIF}
    Forms, Windows, Classes, Controls, Dialogs,
    StdCtrls, SysUtils, ExtCtrls, Grids_ts, TSGrid, Buttons, Graphics;

type
    TtsImageCollection_ = class(TtsImageCollection);

    TtsImageCollectionEditor = class(TPropertyEditor)
    public
        function GetAttributes: TPropertyAttributes; override;
        function GetValue: string; override;
        procedure Edit; override;
    end;

    TtsImageListEditor = class(TComponentEditor)
    protected
        FEditor: TPropertyEditor;
        {$IFDEF TSVER_V6}
        procedure GetImageListEditor(const Prop: IProperty);
        {$ELSE}
        procedure GetImageListEditor(PropertyEditor: TPropertyEditor);
        {$ENDIF}
    public
        procedure Edit; override;
    published
        procedure ExecuteVerb(Index: Integer); override;
        function GetVerb(Index: Integer): string; override;
        function GetVerbCount: Integer; override;
    end;

    TtsImageListDlg = class(TForm)
        grdImages: TtsGrid;
        Bevel1: TBevel;
        Bevel2: TBevel;
        butDelete: TSpeedButton;
        butAdd: TSpeedButton;
        bvlSeperator2: TBevel;
        butLeft: TSpeedButton;
        butRight: TSpeedButton;
        butLoad: TSpeedButton;
        bvlSeperator1: TBevel;
        dlgLoadPicture: TOpenDialog;
        cmbGlobalSetName: TComboBox;
        lblSetName: TLabel;
        butOK: TButton;
        butCancel: TButton;
        dlgColor: TColorDialog;
        lblName: TLabel;
        shpFixedColor: TShape;
        lblSize: TLabel;
        lblPictureSize: TLabel;
        txtName: TEdit;
        optLowerLeftPixel: TRadioButton;
        optFixedColor: TRadioButton;
        butSelectColor: TButton;
        chkTransparent: TCheckBox;
        bvlProperties: TBevel;
        lblProperties: TLabel;
        butAddSet: TSpeedButton;
        butDeleteSet: TSpeedButton;
        bvlSeperator3: TBevel;
        butMoveToSet: TSpeedButton;
        butEditSet: TSpeedButton;

        procedure FormCreate(Sender: TObject);
        procedure butAddClick(Sender: TObject);
        procedure FormShow(Sender: TObject);
        procedure grdImagesPaintCell(Sender: TObject; DataCol, DataRow: Longint;
        ARect: TRect; State: TtsPaintCellState; var Cancel: Boolean);
        procedure butLoadClick(Sender: TObject);
        procedure butDeleteClick(Sender: TObject);
        procedure butLeftClick(Sender: TObject);
        procedure butRightClick(Sender: TObject);
        procedure grdImagesColChanged(Sender: TObject; OldCol, NewCol: Longint);
        procedure cmbGlobalSetNameClick(Sender: TObject);
        procedure butSelectColorClick(Sender: TObject);
        procedure optFixedColorClick(Sender: TObject);
        procedure optLowerLeftPixelClick(Sender: TObject);
        procedure chkTransparentClick(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure butOKClick(Sender: TObject);
        procedure grdImagesDblClickCell(Sender: TObject; DataCol,
        DataRow: Longint; Pos: TtsClickPosition);
        procedure butDeleteSetClick(Sender: TObject);
        procedure txtNameKeyPress(Sender: TObject; var Key: Char);
        procedure butAddSetClick(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
        procedure butCancelClick(Sender: TObject);
        procedure butMoveToSetClick(Sender: TObject);
        procedure grdImagesSelectChanged(Sender: TObject;
        SelectType: TtsSelectType; ByUser: Boolean);
        procedure butEditSetClick(Sender: TObject);
        procedure grdImagesEnter(Sender: TObject);
        procedure chkTransparentEnter(Sender: TObject);
        procedure optLowerLeftPixelEnter(Sender: TObject);
        procedure optFixedColorEnter(Sender: TObject);
        procedure butSelectColorEnter(Sender: TObject);
        procedure cmbGlobalSetNameEnter(Sender: TObject);

    protected
        InDesignMode: Boolean;
        procedure ImageCollectionChanged(Sender: TObject);
        function HandleNameChange: Boolean;

    public
        ImageCollection: TtsImageCollection;
        ItemIndex: Variant;
        Modified: Boolean;
    end;

implementation

{$R *.DFM}

uses
    TSCommon, TypInfo, TSSetName;

const
    MainSetName = '(main)';
    JPegLibraryName = 'TSGJPEG';

type
    TLoadJPegStream = procedure(Filename: PChar; var Stream: TMemoryStream; var Buffer: Pointer; var BufSize: Integer); stdcall;
    TFreeJPegStream = procedure(Stream: TStream); stdcall;

var
    Dlg: TtsImageListDlg;
    IgnoreChange: Boolean;
    CloseButtonPressed: Boolean;

procedure LoadGraphic(Filename: String; Bitmap: TBitmap);
var
    Temp: string;
    TempBitmap: TBitmap;
    Icon: TIcon;
    MetaFile: TMetaFile;
    Handle: THandle;
    LoadJPegStream: TLoadJPegStream;
    FreeJPegStream: TFreeJPegStream;
    LoadStream, BitmapStream: TMemoryStream;
    Buffer: Pointer;
    BufSize: Integer;
begin
    TempBitmap := TBitmap.Create;
    {$IFDEF TSVER_V3}
    TempBitmap.TransparentColor := clWhite;
    TempBitmap.TransparentMode := tmAuto;
    TempBitmap.PixelFormat := pf24bit;
    {$ENDIF}

    try
        Temp := UpperCase(Trim(Filename)) + ' ';
        Temp := Copy(Temp, Length(Temp) - 3, 4);

        if (Temp='JPG ') or (Temp='JPEG') then
        begin
            Handle := LoadLibrary(JPegLibraryName);
            if Handle <> 0 then
            begin
                try
                    @LoadJPegStream := GetProcAddress(Handle, 'LoadJPegStream');
                    @FreeJPegStream := GetProcAddress(Handle, 'FreeJPegStream');
                    if (@LoadJPegStream <> nil) and (@FreeJPegStream <> nil) then
                    begin
                        LoadStream := nil;
                        BitmapStream := TMemoryStream.Create;
                        try
                            LoadJPegStream(PChar(FileName), LoadStream, Buffer, BufSize);
                            try
                                BitmapStream.Write(Buffer^, BufSize);
                                BitmapStream.Position := 0;
                                TempBitmap.LoadFromStream(BitmapStream);
                            except
                            end;
                        finally
                            FreeJPegStream(LoadStream);
                            BitmapStream.Free;
                        end;
                    end;
                finally
                    FreeLibrary(Handle);
                end;
            end;
        end
        else if (Temp='ICO ') then
        begin
            Icon := TIcon.Create;
            Icon.LoadFromFile(FileName);

            {$IFDEF TSVER_V3}
            TempBitmap.PixelFormat := pf8bit;
            TempBitmap.Transparent := Icon.Transparent;
            {$ENDIF}

            TempBitmap.Height := Icon.Height;
            TempBitmap.Width := Icon.Width;
            TempBitmap.Canvas.Draw(0,0, Icon);

            Icon.Free;
        end
        else if (Temp='WMF ') or (Temp='EMF ') then
        begin
            MetaFile := TMetaFile.Create;
            MetaFile.LoadFromFile(FileName);

            {$IFDEF TSVER_V3}
            TempBitmap.Transparent := MetaFile.Transparent;
            {$ENDIF}

            TempBitmap.Height := MetaFile.Height;
            TempBitmap.Width := MetaFile.Width;
            TempBitmap.Canvas.Draw(0,0, MetaFile);

            MetaFile.Free;
        end
        else
            TempBitmap.LoadFromFile(FileName);

        Bitmap.Assign(TempBitmap);

    finally
        TempBitmap.Free;
    end;
end;

function Max(I, J: Integer): Integer;
begin
    if I > J then
        Result := I
    else
        Result := J;
end;

function VisibleCols(tsGrid: TtsGrid): integer;
var
    I: integer;
    Count: integer;
begin
    Count := 0;
    for I := 1 to tsGrid.Cols do
        if tsGrid.Col[I].Visible then Inc(Count);
    Result := Count;
end;

function RightVisibleCol(Col: integer): integer;
var
    I: integer;
begin
    Result := -1;
    if Dlg.grdImages.Cols > 0 then
    begin
        for I := Col + 1 to Dlg.grdImages.Cols do
        begin
            if Dlg.grdImages.Col[I].Visible then
            begin
                Result := I;
                Break;
            end;
        end;
    end;
end;

function LeftVisibleCol(Col: integer): integer;
var
    I: integer;
begin
    Result := -1;
    if Dlg.grdImages.Cols > 0 then
    begin
        for I := Col - 1 downto 1 do
        begin
            if Dlg.grdImages.Col[I].Visible then
            begin
                Result := I;
                Break;
            end;
        end;
    end;
end;

procedure ClearControls;
begin
    IgnoreChange := True;

    Dlg.txtName.Text := '';
    Dlg.chkTransparent.Checked := False;
    Dlg.optLowerLeftPixel.Checked := False;
    Dlg.optFixedColor.Checked := False;
    Dlg.shpFixedColor.Brush.Style := bsClear;
    Dlg.shpFixedColor.Pen.Color := clGrayText;
    Dlg.butSelectColor.Enabled := False;
    Dlg.lblPictureSize.Caption := '';

    IgnoreChange := False;
end;

procedure FillControls;
var
    I: integer;
    DisableControls: Boolean;
    First: Boolean;
begin
    IgnoreChange := True;
    try
        if Dlg.grdImages.SelectedCols.Count > 1 then
        begin
            Dlg.txtName.Enabled := False;
            Dlg.txtName.Text := '';
            Dlg.chkTransparent.Enabled := True;

            First := True;
            Dlg.chkTransparent.Checked := False;
            for I := 1 to Dlg.grdImages.Cols do
            begin
                if Dlg.grdImages.SelectedCols.Selected[I] then
                begin
                    if not First and (Dlg.chkTransparent.Checked <> Boolean(Dlg.ImageCollection[I - 1].Transparent)) then
                    begin
                        Dlg.chkTransparent.State := cbGrayed;
                        Break;
                    end;

                    Dlg.chkTransparent.Checked := Boolean(Dlg.ImageCollection[I - 1].Transparent);
                    First := False;
                end;
            end;

            Dlg.optLowerLeftPixel.Enabled := (Dlg.chkTransparent.State <> cbUnChecked);
            Dlg.optFixedColor.Enabled := (Dlg.chkTransparent.State <> cbUnChecked);

            if Dlg.chkTransparent.State in [cbUnChecked, cbGrayed] then
            begin
                Dlg.optLowerLeftPixel.Checked := False;
                Dlg.optFixedColor.Checked := False;
            end
            else
            begin
                First := True;
                Dlg.optLowerLeftPixel.Checked := False;
                Dlg.optFixedColor.Checked := False;
                for I := 1 to Dlg.grdImages.Cols do
                begin
                    if Dlg.grdImages.SelectedCols.Selected[I] then
                    begin
                        if not First and
                           (Dlg.optLowerLeftPixel.Checked and (Dlg.ImageCollection[I - 1].TransparentMode = tmFixed)
                            or Dlg.optFixedColor.Checked and (Dlg.ImageCollection[I - 1].TransparentMode = tmAuto))
                        then
                        begin
                            Dlg.optLowerLeftPixel.Checked := False;
                            Dlg.optFixedColor.Checked := False;
                            Break;
                        end;

                        Dlg.optLowerLeftPixel.Checked := (Dlg.ImageCollection[I - 1].TransparentMode = tmAuto);