kaformimageeditor.pas

可以用任何 bitmap 當成 form 的外型 delphi 3.0, 4.0, 5.0, 6.0, 7.0 適用

 CheckBox1.Checked          := NOT (FI.ColorMatching=ExactColorArray);
 Edit1.Text                 := IntToStr(TrackBar1.Position);
 TrackBar1.Enabled          := CheckBox1.Checked;
 Button4.Enabled            := CheckBox1.Checked;
 For X := 0 To FI.ColorArray.Count-1 do
     Panels[X].Color := TColor(FI.ColorArray.Items[X]);
 NumColors                  := FI.ColorArray.Count;
 CCanvas                    := TControlCanvas.Create;
 Try
  CCanvas.Control                := Image1;
  ScrollBox1.HorzScrollBar.Range := Image1.Width;
  ScrollBox1.VertScrollBar.Range := Image1.Height;
  Scale := 1;
  if NumColors > 0 Then ReFill;
  ShowModal;
  if ModalResult=mrOK Then
     Begin
       if NumColors < 2 Then
          Begin
            FI.ColorArray.Clear;
            if CheckBox1.Checked Then
               FI.ColorMatching := Similar
            Else
               FI.ColorMatching := Exact;
            if NumColors=1 Then FI.Color := Panels[0].Color;
          End
       Else
          Begin
            FI.ColorArray.Clear;
            if CheckBox1.Checked Then
               FI.ColorMatching := SimilarColorArray
            Else
               FI.ColorMatching := ExactColorArray;
            For X := 0 To NumColors-1 do
              Begin
                FI.ColorArray.Add(Pointer(Panels[X].Color));
              End;
           End;
       FI.ColorSimilarity  := StrToInt(Edit1.Text);
     End;
 Finally
  CCanvas.Free;
 End;
end;

procedure TColorEditForm.ZoomIn(X, Y: Integer);
Var
  VS : Real;
  HS : Real;
begin
 HS := X/Scale;
 VS := Y/Scale;
 Inc(Scale);
 ScrollBox1.HorzScrollBar.Position := 0;
 ScrollBox1.VertScrollBar.Position := 0;
 Image1.Width  := OW*Scale;
 Image1.Height := OH*Scale;
 ScrollBox1.HorzScrollBar.Range := Image1.Width;
 ScrollBox1.VertScrollBar.Range := Image1.Height;
 ScrollBox1.HorzScrollBar.Position := (Round(HS)*Scale)-(ScrollBox1.ClientWidth Div 2);
 ScrollBox1.VertScrollBar.Position := (Round(VS)*Scale)-(ScrollBox1.ClientHeight Div 2);
end;

procedure TColorEditForm.ZoomOut(X, Y: Integer);
Var
  VS : Real;
  HS : Real;
begin
 if (Scale) > 1 Then
    Begin
      HS := X/Scale;
      VS := Y/Scale;
      Dec(Scale);
      ScrollBox1.HorzScrollBar.Position := 0;
      ScrollBox1.VertScrollBar.Position := 0;
      Image1.Width  := OW*Scale;
      Image1.Height := OH*Scale;
      ScrollBox1.HorzScrollBar.Range := Image1.Width;
      ScrollBox1.VertScrollBar.Range := Image1.Height;
      ScrollBox1.HorzScrollBar.Position := (Round(HS)*Scale)-(ScrollBox1.ClientWidth Div 2);
      ScrollBox1.VertScrollBar.Position := (Round(VS)*Scale)-(ScrollBox1.ClientHeight Div 2);
    End;
end;

procedure TColorEditForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Var
  PT     : TPoint;
begin
 if (ssShift in Shift) Then
    Begin
      if Image1.Cursor <> crLupa_P Then Image1.Cursor := crLupa_P;
      GetCursorPos(PT);
      SetCursorPos(PT.X, PT.Y);
    End;
 if (ssCtrl in Shift) Then
    Begin
      if Image1.Cursor <> crLupa_M Then Image1.Cursor := crLupa_M;
      GetCursorPos(PT);
      SetCursorPos(PT.X, PT.Y);
    End;
 if (ssAlt in Shift) Then
    Begin
      if Image1.Cursor <> crHand Then Image1.Cursor := crHand;
      GetCursorPos(PT);
      SetCursorPos(PT.X, PT.Y);
    End;
end;

procedure TColorEditForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Var
  PT     : TPoint;
begin
  Image1.Cursor := crPipeta_P;
  GetCursorPos(PT);
  SetCursorPos(PT.X, PT.Y);
end;

procedure TColorEditForm.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
Var
  PT    : TPoint;
begin
  LX := X;
  LY := Y;
  //**************************************************************** Drag System
  if  (ssLeft in Shift)
  And (LastDown.X >= 0)
  And (Image1.Cursor = crHand) Then
      Begin
       GetCursorPos(PT);
       Scrollbox1.VertScrollBar.Position :=
       Scrollbox1.VertScrollBar.Position + LastDown.Y - PT.Y;
       Scrollbox1.HorzScrollBar.Position :=
       Scrollbox1.HorzScrollBar.Position + LastDown.X - PT.X;
       LastDown := PT;
      End
  Else
  //********************************************************** Color Info System
  If (Image1.Cursor = crPipeta_P) Then
      Begin
        Panel200.Color :=  CCanvas.Pixels[X,Y];
        Panel200.Caption :=  '$'+IntToHex(Panel200.Color,6);
      End;
end;

function TColorEditForm.IsInvisible(Clr: TColor): Boolean;
Var
 X      : Integer;
 IPixR  : Byte;
 IPixG  : Byte;
 IPixB  : Byte;

 CPixR  : Byte;
 CPixG  : Byte;
 CPixB  : Byte;
 Color  : TColor;
 Sim    : Integer;
begin
 Result := False;
 if Clr = Panel100.Color Then Exit;
 Result := True;
 if CheckBox1.Checked Then
    Begin
      IPixR       := GetRValue(Clr);
      IPixG       := GetGValue(Clr);
      IPixB       := GetBValue(Clr);
      Sim         := StrToInt(Edit1.Text);
      For X := 0 To NumColors-1 do
          Begin
            Color := Panels[X].Color;
            CPixR  := GetRValue(Color);
            CPixG  := GetGValue(Color);
            CPixB  := GetBValue(Color);
            Result :=     (Abs(CPixR-IPixR) <= Sim)
                      And (Abs(CPixG-IPixG) <= Sim)
                      And (Abs(CPixB-IPixB) <= Sim);
            if Result Then Exit;
          End;
    End
 Else
    Begin
      For X := 0 To NumColors-1 do
        Begin
          if Panels[X].Color=Clr Then Exit;
        End;
    End;
 Result := False;
end;

procedure TColorEditForm.Refill;
Var
 X,Y : Integer;
 Clr : TColorRef;
begin
 For Y := 0 To Image2.Picture.Height-1 do
     Begin
       For X := 0 To Image2.Picture.Width-1 do
           Begin
             Clr := Image2.Canvas.Pixels[X,Y];
             if IsInvisible(Clr) Then Image1.Canvas.Pixels[X,Y] := Panel100.Color;
           End;
      End;
end;

procedure TColorEditForm.Image1Click(Sender: TObject);
Var
 X : Integer;
begin
 if (Image1.Cursor=crLupa_P) Then ZoomIn(LX,LY)
 Else
 if (Image1.Cursor=crLupa_M) Then ZoomOut(LX,LY)
 Else
 If (Image1.Cursor = crPipeta_P) Then
    Begin
     if NumColors < 95 Then
        Begin
          For X := 0 To NumColors-1 do
            Begin
              if Panels[X].Color=Panel200.Color Then Exit;
            End;
          Panels[NumColors].Color := Panel200.Color;
          Inc(NumColors);
          Refill;
        End;
    End;
end;

procedure TColorEditForm.Button2Click(Sender: TObject);
begin
//
end;

procedure TColorEditForm.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  GetCursorPos(LastDown);
end;

procedure TColorEditForm.Button1Click(Sender: TObject);
Var
 X : Integer;
begin
 For X := 0 To NumColors-1 do Panels[X].Color := clBtnFace;
 NumColors := 0;
 Image1.Picture.Assign(Image2.Picture);
end;

procedure TColorEditForm.Panel100DblClick(Sender: TObject);
begin
 ColorDialog1.Color := Panel100.Color;
 if ColorDialog1.Execute Then
    Begin
      Panel100.Color := ColorDialog1.Color;
      Refill;
    End;
end;

procedure TColorEditForm.CheckBox1Click(Sender: TObject);
begin
 TrackBar1.Enabled := CheckBox1.Checked;
 Button4.Enabled   := CheckBox1.Checked;
 Image1.Picture.Assign(Image2.Picture);
 Refill;
end;

procedure TColorEditForm.TrackBar1Change(Sender: TObject);
begin
  Edit1.Text := IntToStr(TrackBar1.Position);
end;

procedure TColorEditForm.Button4Click(Sender: TObject);
begin
 Image1.Picture.Assign(Image2.Picture);
 Refill;
end;

procedure TColorEditForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#26 Then
     Begin
       Key := #0;
       if NumColors > 0 Then
          Begin
            Image1.Picture.Assign(Image2.Picture);
            Dec(NumColors);
            Panels[NumColors].Color := clBtnFace;
            Refill;
          End;
     End;
end;

end.