📄 tsimagelisteditor.pas
字号:
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 + -