tsimagelisteditor.pas

企业进销存管理系统

            if ImageCollection[ItemIndex].SetName = '' then
                cmbGlobalSetName.ItemIndex := 0
            else
            begin
                for I := 1 to cmbGlobalSetName.Items.Count - 1 do
                begin
                    if CompareText(ImageCollection[ItemIndex].SetName, cmbGlobalSetName.Items[I]) = 0 then
                    begin
                        cmbGlobalSetName.ItemIndex := I;
                        Break;
                    end;
                end;
            end;

            ShowSetInGrid;
            grdImages.CurrentCell.MoveTo(ImageCollection.Items[ItemIndex].Index + 1, 1);
        end
        else
            ShowSetInGrid;
    end
    else
        ShowSetInGrid;
    //ShowMessage('Step End');
    grdImages.LeftCol := grdImages.CurrentDataCol - 1;
    FillControls;
    EnableButtons;

    ImageCollection.OnChange := ImageCollectionChanged;
    Modified := False;

    Screen.Cursor := crDefault;
end;

procedure TtsImageListDlg.ImageCollectionChanged(Sender: TObject);
begin
    Modified := True;
end;

function TtsImageListDlg.HandleNameChange: Boolean;
var
    Ok: Boolean;
    Name: string;
    I: Integer;
begin
    Result := True;
    if not txtName.Modified then Exit;

    Name := Trim(txtName.Text);
    Ok := True;

    if Pos('.', Name) > 0 then
    begin
       MessageDlg('Illegal character in name. Dots can not be used.', mtError, [mbOk], 0);
       Ok := False;
    end;

    if Ok and (Name = '') then
    begin
       MessageDlg('The image must have a name.', mtError, [mbOk], 0);
       Ok := False;
    end;

    if Ok then
    begin
        I := ImageCollection.NameIndex(ImageCollection[grdImages.CurrentDataCol - 1].SetName + '.' + Name);
        if (I < 0) or (I = grdImages.CurrentDataCol - 1) then
        begin
            ImageCollection[grdImages.CurrentDataCol - 1].Name := Trim(txtName.Text);
            grdImages.Col[grdImages.CurrentDataCol].Heading := Trim(txtName.Text);
            txtName.Text := Trim(txtName.Text);
        end
        else
        begin
            if ImageCollection[grdImages.CurrentDataCol - 1].SetName = '' then
                MessageDlg('Name ''' + txtName.Text + ''' already exists. Names must be unique within a set.', mtError, [mbOk], -1)
            else
                MessageDlg('Name ''' + txtName.Text + ''' already exists in the set ''' + ImageCollection[grdImages.CurrentDataCol - 1].SetName + '''. Names must be unique within a set.', mtError, [mbOk], -1);
            Ok := False;
        end;
    end;

    if not Ok then
    begin
        txtName.SelectAll;
        txtName.SetFocus;
        Result := False;
    end
    else
        txtName.Modified := False;
end;

procedure TtsImageListDlg.grdImagesPaintCell(Sender: TObject; DataCol,
  DataRow: Longint; ARect: TRect; State: TtsPaintCellState;
  var Cancel: Boolean);
var
    Image: TBitmap;
    Bitmap: TBitmap;
    TransparentColor: TColor;
    OldStyle: TBrushStyle;
begin
    if DataRow = 0 then Exit;

    Cancel := True;

    //workaround for bug in TCanvas
    Image := TBitmap.Create;
    {$IFDEF TSVER_V3}
    Image.PixelFormat := pf32bit;
    {$ENDIF}
    Image.Height := 1;
    Image.Width := 1;
    grdImages.Canvas.Draw(ARect.Left, ARect.Top, Image);
    Image.Free;

    grdImages.Canvas.Brush.Color := grdImages.Color;
    grdImages.Canvas.Brush.Style := bsSolid;
    grdImages.Canvas.FillRect(ARect);

    ARect.Left := ARect.Left + 3;
    ARect.Right := ARect.Right - 3;
    ARect.Top := ARect.Top + 3;
    ARect.Bottom := ARect.Bottom - 3;

    if (State = [psCurrent]) and (grdImages.SelectedCols.Count = 0) then
    begin
        grdImages.Canvas.Brush.Color := clBlack;
        grdImages.Canvas.Framerect(ARect);
    end;

    ARect.Left := ARect.Left + 3;
    ARect.Right := ARect.Right - 3;
    ARect.Top := ARect.Top + 3;
    ARect.Bottom := ARect.Bottom - 3;

    Bitmap := ImageCollection[DataCol - 1].Bitmap;

    if ImageCollection[DataCol - 1].Transparent then
        TransparentColor := ImageCollection[DataCol - 1].TransparentColor
    else
        TransparentColor := clNone;

    OldStyle := grdImages.Canvas.Brush.Style;
    grdImages.Canvas.Brush.Style := bsSolid;
    grdImages.Canvas.Brush.Color := grdImages.Color;

    tsStretchDraw(grdImages.Canvas, ARect, Bitmap, TransparentColor, True, False, True, True);
    grdImages.Canvas.Brush.Style := OldStyle;
end;

procedure TtsImageListDlg.grdImagesColChanged(Sender: TObject;
  OldCol, NewCol: Longint);
begin
    if (OldCol <> NewCol) and (NewCol >= grdImages.LeftCol + grdImages.VisibleCols - 1) then
    begin
        grdImages.CurrentCell.PutInView;
    end;

    FillControls;
    EnableButtons;
end;

procedure TtsImageListDlg.grdImagesDblClickCell(Sender: TObject; DataCol,
  DataRow: Longint; Pos: TtsClickPosition);
begin
    if (DataCol > 0) and not InDesignMode then
        butOKClick(Sender);
end;

procedure TtsImageListDlg.grdImagesSelectChanged(Sender: TObject;
  SelectType: TtsSelectType; ByUser: Boolean);
begin
    FillControls;
    EnableButtons;
end;

procedure TtsImageListDlg.butDeleteSetClick(Sender: TObject);
var
    I: integer;
    Temp: string;
begin
    if HandleNameChange() = False then Exit;

    if mrOk = MessageDlg('Delete set ''' + cmbGlobalSetName.Text + ''' and all the pictures in it?', mtConfirmation, [mbOk, mbCancel], 0) then
    begin
        Temp := Trim(LowerCase(cmbGlobalSetName.Text));
        if Temp = MainSetName then Temp := '';

        I := 0;
        while I <= ImageCollection.Count - 1 do
            if Trim(LowerCase(ImageCollection[I].SetName)) = Temp then
            begin
                ImageCollection[I].Free;
                grdImages.DeleteCols(I + 1, I + 1);
            end
            else
                Inc(I, 1);

        if TtsImageCollection_(ImageCollection).SetNames.IndexOf(Temp)>=0 then
            TtsImageCollection_(ImageCollection).SetNames.Delete(TtsImageCollection_(ImageCollection).SetNames.IndexOf(Temp));

        cmbGlobalSetName.Items.Delete(cmbGlobalSetName.ItemIndex);
        cmbGlobalSetName.ItemIndex := 0;

        ShowSetInGrid;
        if VisibleCols(grdImages) > 0 then grdImages.CurrentCell.MoveTo(1, 1);
        EnableButtons;
        FillControls;
        if txtName.Enabled then txtName.SetFocus;
    end
end;

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

    SetNameDlg := TtsSetNameDlg.Create(Self);
    try
        SetNameDlg.cmbSetNames.Items := cmbGlobalSetName.Items;
        SetNameDlg.Caption := 'Add new set';
        SetNameDlg.cmbSetNames.Visible := False;
        SetNameDlg.txtSetName.Visible := True;
        SetNameDlg.txtSetName.Text := '';
        if mrOk = SetNameDlg.ShowModal then
        begin
            TtsImageCollection_(ImageCollection).SetNames.Add(Trim(SetNameDlg.txtSetName.Text));
            cmbGlobalSetName.Items.Add(Trim(SetNameDlg.txtSetName.Text));
            cmbGlobalSetName.ItemIndex := cmbGlobalSetName.Items.Count - 1;
            ShowSetInGrid;
            EnableButtons;
            FillControls;
        end;
    finally
        SetNameDlg.Free;
    end;
end;

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

    SetNameDlg := TtsSetNameDlg.Create(Self);
    try
        SetNameDlg.cmbSetNames.Items := cmbGlobalSetName.Items;
        SetNameDlg.Caption := 'Edit setname';
        SetNameDlg.cmbSetNames.Visible := False;
        SetNameDlg.txtSetName.Visible := True;
        SetNameDlg.txtSetName.Text := cmbGlobalSetName.Text;
        SetNameDlg.txtSetName.AutoSelect := True;
        if mrOk = SetNameDlg.ShowModal then
        begin
            I := TtsImageCollection_(ImageCollection).SetNames.IndexOf(cmbGlobalSetName.Text);
            if I >=0 then
                TtsImageCollection_(ImageCollection).SetNames[I] := Trim(SetNameDlg.txtSetName.Text);

            for I := 0 to ImageCollection.Count - 1 do
                if Trim(LowerCase(ImageCollection[I].SetName)) = Trim(LowerCase(cmbGlobalSetName.Text)) then
                    ImageCollection[I].SetName := Trim(SetNameDlg.txtSetName.Text);

            I := cmbGlobalSetName.ItemIndex;
            cmbGlobalSetName.Items[I] := Trim(SetNameDlg.txtSetName.Text);
            cmbGlobalSetName.ItemIndex := I;

            FillControls;
        end;
    finally
        SetNameDlg.Free;
    end;
end;

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

    if grdImages.Cols > 0 then
    begin
        dlgLoadPicture.Options := dlgLoadPicture.Options - [ofAllowMultiSelect];
        if dlgLoadPicture.Execute then
        begin
            LoadGraphic(dlgLoadPicture.Filename, ImageCollection[grdImages.CurrentDataCol - 1].Bitmap);
            grdImages.RefreshData(roBoth, rpNone);
            grdImages.CurrentCell.PutInView;
        end;
    end;
end;

procedure TtsImageListDlg.butAddClick(Sender: TObject);
var
    tsImage: TtsImage;
    I, P, Count: integer;
    FirstCol: integer;
    Temp: string;
    SetName: string;
begin
    if HandleNameChange() = False then Exit;
    grdImages.ResetColProperties([prSelected]);

    tsImage := nil;
    FirstCol := grdImages.Cols + 1;
    SetName := cmbGlobalSetName.Text;
    if SetName = MainSetName then SetName := '';

    dlgLoadPicture.Options := dlgLoadPicture.Options + [ofAllowMultiSelect];
    if dlgLoadPicture.Execute then
    begin
        Count := 0;
        try
            for I := 0 to dlgLoadPicture.Files.Count - 1 do
            begin
                 try
                    tsImage := ImageCollection.Add;
                    LoadGraphic(dlgLoadPicture.Files[I], tsImage.Bitmap);

                    for P := Length(dlgLoadPicture.Files[I]) downto 1 do
                        if Copy(dlgLoadPicture.Files[I], P , 1) = '\' then Break;

                    if P < Length(dlgLoadPicture.Files[I]) then Inc(P, 1);

                    dlgLoadPicture.Files[I] := Copy(dlgLoadPicture.Files[I], P, Length(dlgLoadPicture.Files[I]));

                    P := Pos('.', dlgLoadPicture.Files[I]) - 1;
                    if P < 0 then P := Length(dlgLoadPicture.Files[I]);
                    dlgLoadPicture.Files[I] := Copy(dlgLoadPicture.Files[I], 1, P);

                    for P := 0 to 99 do
                    begin
                        Temp := dlgLoadPicture.Files[I];
                        if P > 0 then Temp := Temp + IntToStr(P);
                        if ImageCollection.NameIndex(SetName + '.' + Temp) < 0 then
                        begin
                            tsImage.SetName := SetName;
                            tsImage.Name := Temp;
                        end;
                        if tsImage.Name = Temp then Break;
                    end;

                    if cmbGlobalSetName.Text = MainSetName then
                        tsImage.SetName := ''
                    else
                        tsImage.SetName := cmbGlobalSetName.Text;

                    Inc(Count, 1);
                except
                    on E: Exception do
                    begin
                        MessageDlg(E.message, mtError, [mbOK], 0);
                        tsImage.Free;
                    end;
                end;
            end;
        finally
            if Count > 0 then
            begin
                grdImages.Cols := grdImages.Cols + Count;
                for I := FirstCol to grdImages.Cols do
                begin
                    grdImages.Col[I].ControlType := ctPicture;
                    grdImages.Col[I].Width := 100;
                    grdImages.Col[I].Heading := ImageCollection[I - 1].Name;
                end;

                grdImages.CurrentCell.MoveTo(FirstCol, 1);
                grdImages.CurrentCell.PutInView;

                EnableButtons;
                txtName.SetFocus;
            end;
        end;
    end;
end;

procedure TtsImageListDlg.butDeleteClick(Sender: TObject);