139 lines
2.8 KiB
ObjectPascal
139 lines
2.8 KiB
ObjectPascal
unit ImageColoring;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, ExtCtrls, StdCtrls, cmap;
|
|
|
|
type
|
|
TfrmImageColoring = class(TForm)
|
|
cbEnable: TCheckBox;
|
|
Panel1: TPanel;
|
|
Panel2: TPanel;
|
|
Panel3: TPanel;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
cmbPalette1: TComboBox;
|
|
Label4: TLabel;
|
|
imgPal1: TImage;
|
|
imgpal2: TImage;
|
|
Label5: TLabel;
|
|
cmbPalette2: TComboBox;
|
|
procedure cmbPalette2Change(Sender: TObject);
|
|
procedure cmbPalette1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
procedure cmbPalette1Change(Sender: TObject);
|
|
private
|
|
FPal1: TColorMap;
|
|
FPal2: TColorMap;
|
|
FBkuPal1: TColorMap;
|
|
FBkuPal2: TColorMap;
|
|
Index1: integer;
|
|
Index2: integer;
|
|
|
|
procedure DrawPalette1;
|
|
procedure DrawPalette2;
|
|
|
|
procedure Apply;
|
|
public
|
|
procedure Update;
|
|
end;
|
|
|
|
var
|
|
frmImageColoring: TfrmImageColoring;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
Main, Editor, Mutate, GradientHlpr;
|
|
|
|
{ TfrmImageColoring }
|
|
|
|
procedure TfrmImageColoring.Update;
|
|
begin
|
|
// FPal1 := MainCP.Pal;
|
|
FBkuPal1 := FPal1;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.cmbPalette1Change(Sender: TObject);
|
|
begin
|
|
Index1 := cmbPalette1.ItemIndex;
|
|
GetCmap(Index1, 1, FPal1);
|
|
FBkuPal1 := FPal1;
|
|
// ScrollBar.Position := 0;
|
|
DrawPalette1;
|
|
Apply;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.Apply;
|
|
begin
|
|
MainForm.StopThread;
|
|
MainForm.UpdateUndo;
|
|
|
|
MainCp.CmapIndex := cmbPalette1.ItemIndex;
|
|
MainCp.cmap := FPal1;
|
|
|
|
if EditForm.visible then EditForm.UpdateDisplay;
|
|
if MutateForm.Visible then MutateForm.UpdateDisplay;
|
|
|
|
MainForm.RedrawTimer.enabled := true;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.cmbPalette1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
|
|
var
|
|
Bitmap: TBitmap;
|
|
PalName: string;
|
|
begin
|
|
BitMap := GradientHelper.GetGradientBitmap(Index, 1);
|
|
|
|
GetCmapName(index, PalName);
|
|
|
|
with Control as TComboBox do begin
|
|
Canvas.Rectangle(Rect);
|
|
|
|
Canvas.TextOut(4, Rect.Top, PalName);
|
|
Rect.Left := (Rect.Left + rect.Right) div 2;
|
|
Canvas.StretchDraw(Rect, Bitmap);
|
|
end;
|
|
BitMap.Free;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.DrawPalette1;
|
|
var
|
|
Bitmap: TBitmap;
|
|
begin
|
|
BitMap := GradientHelper.GetGradientBitmap(Index1, 1);
|
|
|
|
imgPal1.Picture.Graphic := Bitmap;
|
|
imgPal1.Refresh;
|
|
|
|
BitMap.Free;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.DrawPalette2;
|
|
var
|
|
Bitmap: TBitmap;
|
|
begin
|
|
BitMap := GradientHelper.GetGradientBitmap(Index2, 1);
|
|
|
|
imgPal2.Picture.Graphic := Bitmap;
|
|
imgPal2.Refresh;
|
|
|
|
BitMap.Free;
|
|
end;
|
|
|
|
procedure TfrmImageColoring.cmbPalette2Change(Sender: TObject);
|
|
begin
|
|
Index2 := cmbPalette2.ItemIndex;
|
|
GetCmap(Index2, 1, FPal2);
|
|
FBkuPal2 := FPal2;
|
|
// ScrollBar.Position := 0;
|
|
DrawPalette2;
|
|
Apply;
|
|
end;
|
|
|
|
end.
|