⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tsimagelisteditor.pas

📁 企业进销存管理系统
💻 PAS
📖 第 1 页 / 共 4 页
字号:
var
    I: integer;
begin
    if VisibleCols(grdImages) > 0 then
    begin
        if grdImages.SelectedCols.Count > 0 then
            I := grdImages.SelectedCols.Previous(grdImages.Cols + 1)
        else
            I := grdImages.CurrentDataCol;

        repeat
            ImageCollection[I - 1].Free;
            grdImages.DeleteCols(I, I);
            I := grdImages.SelectedCols.Previous(I);
        until (I = -1) or (grdImages.SelectedCols.Count = 0);

        ShowSetInGrid;
        if VisibleCols(grdImages) > 0 then
        begin
            grdImages.RefreshData(roBoth, rpNone);
            grdImages.CurrentCell.PutInView;
            FillControls;
        end;
        EnableButtons;
    end;
end;

procedure TtsImageListDlg.butLeftClick(Sender: TObject);
var
    Temp: TtsImage;
    LeftColnr: integer;
begin
    if HandleNameChange() = False then Exit;

    LeftColnr := LeftVisibleCol(Dlg.grdImages.CurrentDataCol);
    if LeftColnr >= 1 then
    begin
        if grdImages.SelectedCols.Count > 0 then grdImages.ResetColProperties([prSelected]);

        Temp := TtsImage.Create(nil);
        Temp.Assign(ImageCollection[LeftColnr - 1]);
        ImageCollection[LeftColnr - 1].Assign(ImageCollection[grdImages.CurrentDataCol - 1]);
        ImageCollection[grdImages.CurrentDataCol - 1].Assign(Temp);
        Temp.Free;

        grdImages.EnablePaint := False;
        try
            grdImages.Col[grdImages.CurrentDataCol].Heading := ImageCollection[grdImages.CurrentDataCol - 1].Name;
            grdImages.Col[LeftColNr].Heading := ImageCollection[LeftColNr - 1].Name;

            grdImages.CurrentCell.MoveTo(LeftColnr,1);
            grdImages.CurrentCell.PutInView;
        finally
            grdImages.EnablePaint := True;
        end;
    end;
end;


procedure TtsImageListDlg.butRightClick(Sender: TObject);
var
    Temp: TtsImage;
    RightColnr: integer;
begin
    if HandleNameChange() = False then Exit;

    RightColnr := RightVisibleCol(Dlg.grdImages.CurrentDataCol);

    if (RightColnr <= grdImages.Cols) and (RightColnr > 0) then
    begin
        if grdImages.SelectedCols.Count > 0 then grdImages.ResetColProperties([prSelected]);

        Temp := TtsImage.Create(nil);
        Temp.Assign(ImageCollection[RightColnr - 1]);
        ImageCollection[RightColnr - 1].Assign(ImageCollection[grdImages.CurrentDataCol - 1]);
        ImageCollection[grdImages.CurrentDataCol - 1].Assign(Temp);
        Temp.Free;

        grdImages.EnablePaint := False;
        try
            grdImages.Col[grdImages.CurrentDataCol].Heading := ImageCollection[grdImages.CurrentDataCol - 1].Name;
            grdImages.Col[RightColNr].Heading := ImageCollection[RightColNr - 1].Name;

            grdImages.CurrentCell.MoveTo(RightColnr,1);
            grdImages.CurrentCell.PutInView;
        finally
            grdImages.EnablePaint := True;
        end;
    end;
end;

procedure TtsImageListDlg.butMoveToSetClick(Sender: TObject);
var
    SetNameDlg: TtsSetNameDlg;
    I: Integer;
begin
    if HandleNameChange() = False then Exit;

    SetNameDlg := TtsSetNameDlg.Create(Self);
    try
        SetNameDlg.Caption := 'Move picture to different set';
        SetNameDlg.txtSetName.Visible := False;
        SetNameDlg.cmbSetNames.Visible := True;
        SetNameDlg.cmbSetNames.Items := cmbGlobalSetName.Items;
        SetNameDlg.cmbSetNames.ItemIndex := cmbGlobalSetName.ItemIndex;

        if mrOk = SetNameDlg.ShowModal then
        begin
            if SetNameDlg.cmbSetNames.ItemIndex <> cmbGlobalSetName.ItemIndex then
            begin
                if grdImages.SelectedCols.Count > 0 then
                    I := grdImages.SelectedCols.Next(0)
                else
                    I := grdImages.CurrentDataCol;

                repeat
                    try
                        if SetNameDlg.cmbSetNames.Text = MainSetName then
                            ImageCollection[I - 1].SetName := ''
                        else
                            ImageCollection[I - 1].SetName := SetNameDlg.cmbSetNames.Text;
                    except
                        on E: Exception do MessageDlg(E.message, mtError, [mbOK], 0);
                    end;
                    I := grdImages.SelectedCols.Next(I);
                until (I < 0) or (grdImages.SelectedCols.Count = 0);
                ShowSetInGrid;

                FillControls;
                EnableButtons;
                if txtName.Enabled then txtName.SetFocus;
            end;
        end;
    finally
        SetNameDlg.Free;
    end;
end;

procedure TtsImageListDlg.txtNameKeyPress(Sender: TObject; var Key: Char);
begin
    if Key = Chr(13) then
    begin
        Key := Chr(0);
        HandleNameChange();
        txtName.SelectAll;
    end;
end;

procedure TtsImageListDlg.cmbGlobalSetNameClick(Sender: TObject);
var
    I: integer;
    Temp: string;
begin
    if grdImages.Cols = 0 then
    Begin
        EnableButtons;
        Exit;
    End;

    ShowSetInGrid;
    if VisibleCols(grdImages) = 0 then
        ClearControls
    else
    begin
        Temp := Trim(LowerCase(cmbGlobalSetName.Text));
        if Temp = MainSetName then Temp := '';

        for I := 0 to ImageCollection.Count - 1 do
        begin
            if Trim(LowerCase(ImageCollection[I].SetName)) = Temp then
            begin
                grdImages.CurrentCell.MoveTo(I + 1 ,1);
                Break;
            end;
        end;

        grdImages.RefreshData(roNone, rpTopLeft);
        EnableButtons;
        FillControls;
    end;
end;


procedure TtsImageListDlg.butSelectColorClick(Sender: TObject);
var
    I: Integer;
begin
    if HandleNameChange() = False then Exit;

    dlgColor.Color := $FFFFFF and ImageCollection[grdImages.CurrentDataCol - 1].TransparentColor;
    if dlgColor.Execute then
    begin
        shpFixedColor.Brush.Color := dlgColor.Color;

        if grdImages.SelectedCols.Count > 0 then
            I := grdImages.SelectedCols.Next(0)
        else
            I := grdImages.CurrentDataCol;

        repeat
            ImageCollection[I - 1].TransparentColor := dlgColor.Color;
            I := grdImages.SelectedCols.Next(I);
        until (I = -1) or (grdImages.SelectedCols.Count = 0);
        grdImages.RefreshData(roNone, rpNone);
    end;
end;

procedure TtsImageListDlg.optFixedColorClick(Sender: TObject);
var
    FirstColor: Variant;
    I: Integer;
begin
    if not IgnoreChange then
    begin
        if HandleNameChange() = False then Exit;

        butSelectColor.Enabled := True;
        shpFixedColor.Brush.Style := bsSolid;
        shpFixedColor.Pen.Color := clBlack;

        if grdImages.SelectedCols.Count > 0 then
            I := grdImages.SelectedCols.Next(0)
        else
            I := grdImages.CurrentDataCol;

        FirstColor := UnAssigned;
        repeat
            ImageCollection[I - 1].TransparentMode := tmFixed;
            if VarIsEmpty(FirstColor) then
                FirstColor := ImageCollection[I - 1].TransparentColor
            else
                ImageCollection[I - 1].TransparentColor := FirstColor;
            I := grdImages.SelectedCols.Next(i);
        until (I = -1) or (grdImages.SelectedCols.Count = 0);

        shpFixedColor.Brush.Color := FirstColor;
        grdImages.RefreshData(roNone, rpNone);
    end;
end;

procedure TtsImageListDlg.optLowerLeftPixelClick(Sender: TObject);
var
    I: Integer;
begin
    if not IgnoreChange then
    begin
        if HandleNameChange() = False then Exit;

        butSelectColor.Enabled := False;
        shpFixedColor.Brush.Style := bsClear;
        shpFixedColor.Pen.Color := clGrayText;

        if grdImages.SelectedCols.Count > 0 then
            I := grdImages.SelectedCols.Next(0)
        else
            I := grdImages.CurrentDataCol;

        repeat
            ImageCollection[I - 1].TransparentMode := tmAuto;
            I := grdImages.SelectedCols.Next(I);
        until (I = -1) or (grdImages.SelectedCols.Count = 0);
        grdImages.RefreshData(roNone, rpNone);
    end;
end;

procedure TtsImageListDlg.chkTransparentClick(Sender: TObject);
var
    I: Integer;
    FirstColor: Variant;
    FirstMode: Variant;
begin
    if not IgnoreChange then
    begin
        if HandleNameChange() = False then Exit;

        if grdImages.SelectedCols.Count > 0 then
            I := grdImages.SelectedCols.Next(0)
        else
            I := grdImages.CurrentDataCol;

        FirstColor := UnAssigned;
        FirstMode := UnAssigned;
        repeat
            ImageCollection[I - 1].Transparent := chkTransparent.Checked;

            if chkTransparent.Checked then
            begin
                if VarIsEmpty(FirstMode) then
                    FirstMode := ImageCollection[I - 1].TransparentMode
                else
                    ImageCollection[I - 1].TransparentMode := FirstMode;

                if FirstMode = tmFixed then
                begin
                    ImageCollection[I - 1].TransparentMode := tmFixed;
                    if VarIsEmpty(FirstColor) then
                        FirstColor := ImageCollection[I - 1].TransparentColor
                    else
                        ImageCollection[I - 1].TransparentColor := FirstColor;
                end
            end;

            I := grdImages.SelectedCols.Next(i);
        until (I = -1) or (grdImages.SelectedCols.Count = 0);

        grdImages.RefreshData(roNone, rpNone);
        FillControls;
    end;
end;

procedure TtsImageListDlg.butCancelClick(Sender: TObject);
begin
    CloseButtonPressed := True;
end;

procedure TtsImageListDlg.butOKClick(Sender: TObject);
begin
    if HandleNameChange() = False then Exit;

    if (grdImages.SelectedCols.Count > 1) and not InDesignMode then
    begin
        MessageDlg('Only one image can be selected.', mtError, [mbOK], 0);
        Exit;
    end;

    if VarType(ItemIndex) = varString then
    begin
        if VisibleCols(grdImages) <= 0 then
            ItemIndex := ''
        else
            ItemIndex := ImageCollection[grdImages.CurrentDataCol - 1].SetName + '.' + ImageCollection[grdImages.CurrentDataCol - 1].Name
    end
    else
    begin
        if VisibleCols(grdImages) <= 0 then
            ItemIndex := -1
        else
            ItemIndex := grdImages.CurrentDataCol - 1;
    end;

    ModalResult := mrOk;
    CloseButtonPressed := True;
end;

procedure TtsImageListDlg.grdImagesEnter(Sender: TObject);
begin
    HandleNameChange;
end;

procedure TtsImageListDlg.chkTransparentEnter(Sender: TObject);
begin
    HandleNameChange;
end;

procedure TtsImageListDlg.optLowerLeftPixelEnter(Sender: TObject);
begin
    HandleNameChange;
end;

procedure TtsImageListDlg.optFixedColorEnter(Sender: TObject);
begin
    HandleNameChange;
end;

procedure TtsImageListDlg.butSelectColorEnter(Sender: TObject);
begin
    HandleNameChange;
end;

procedure TtsImageListDlg.cmbGlobalSetNameEnter(Sender: TObject);
begin
    HandleNameChange;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -