📄 jvqfullcolorspaceseditors.pas
字号:
{******************************************************************************}
{* WARNING: JEDI VCL To CLX Converter generated unit. *}
{* Manual modifications will be lost on next release. *}
{******************************************************************************}
{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: ColorSpacesEditors.pas, released on 2004-09-11.
The Initial Developer of the Original Code is Florent Ouchet [ouchet dott florent att laposte dott net]
Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet.
All Rights Reserved.
Contributor(s): -
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQFullColorSpacesEditors.pas,v 1.1 2005/02/11 16:53:05 asnepvangers Exp $
unit JvQFullColorSpacesEditors;
{$I jvcl.inc}
interface
uses
QWindows, Classes, QGraphics,
DesignIntf, DesignEditors, DesignMenus, CLXEditors,
JvQFullColorSpaces;
type
TJvDEFFamily = (pfConstant, pfSystem);
TJvFullColorProperty = class(TPropertyEditor)
private
function GetIsColorProperty: Boolean;
procedure DialogApply(Sender: TObject; AFullColor: TJvFullColor);
public
function GetAttributes: TPropertyAttributes; override;
procedure GetProperties(Proc: TGetPropProc ); override;
procedure GetValues(Proc: TGetStrProc); override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
procedure Edit; override;
procedure EditSpace(AColorID: TJvFullColorSpaceID);
procedure SetColor(AFullColor: TJvFullColor);
// ICustomPropertyDrawing
property IsColorProperty: Boolean read GetIsColorProperty;
end;
TJvFullColorSpaceProperty = class(TNestedProperty)
private
FColorSpace: TJvColorSpace;
FParent: TJvFullColorProperty;
public
constructor Create(AParent: TJvFullColorProperty; AColorSpace: TJvColorSpace;
AIsColorProperty: Boolean);
function GetName: string; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure GetProperties(Proc: TGetPropProc ); override;
procedure Edit; override;
property ColorSpace: TJvColorSpace read FColorSpace;
property Parent: TJvFullColorProperty read FParent;
end;
TJvFullColorSpacePropertyClass = class of TJvFullColorSpaceProperty;
TJvFullColorAxisProperty = class(TNestedProperty)
private
FAxisIndex: TJvAxisIndex;
FParent:TJvFullColorSpaceProperty;
public
constructor Create(AParent: TJvFullColorSpaceProperty;
AAxisIndex: TJvAxisIndex);
function GetName: string; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
procedure GetValues(Proc: TGetStrProc); override;
property Parent: TJvFullColorSpaceProperty read FParent;
property AxisIndex: TJvAxisIndex read FAxisIndex;
end;
TJvDEFColorSpaceProperty = class(TJvFullColorSpaceProperty)
public
procedure GetProperties(Proc: TGetPropProc ); override;
end;
TJvDEFColorSpaceIndentProperty = class(TNestedProperty)
private
FPredefinedFamily: TJvDEFFamily;
FParent: TJvDEFColorSpaceProperty;
public
constructor Create(AParent: TJvDEFColorSpaceProperty;
APredefinedFamily: TJvDEFFamily);
function GetName: string; override;
function GetAttributes: TPropertyAttributes; override;
function GetValue: string; override;
procedure SetValue(const Value: string); override;
procedure GetValues(Proc: TGetStrProc); override;
property Parent: TJvDEFColorSpaceProperty read FParent;
property PredefinedFamily: TJvDEFFamily read FPredefinedFamily;
end;
// obones: If anyone finds out a TSelectionEditor for C5/D5, please
// feel free to do the required changes
TJvFullColorSelection = class(TSelectionEditor)
protected
procedure RequireClass(Proc: TGetStrProc; AClass: TClass);
public
procedure ExecuteVerb(Index: Integer; const List: IDesignerSelections); override;
function GetVerb(Index: Integer): string; override;
function GetVerbCount: Integer; override;
procedure RequiresUnits(Proc: TGetStrProc); override;
procedure PrepareItem(Index: Integer; const AItem: IMenuItem); override;
end;
TJvFullColorListEditor = class(TClassProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure Edit; override;
function AllEqual: Boolean; override;
procedure FormApply(Sender: TObject);
end;
procedure RegisterFullColorSpaceEditor (AColorSpaceID: TJvFullColorSpaceID;
AEditorClass: TJvFullColorSpacePropertyClass);
function FindFullColorSpaceEditor (AColorSpaceID: TJvFullColorSpaceID): TJvFullColorSpacePropertyClass;
var
DefaultFullColorSpacePropertyClass: TJvFullColorSpacePropertyClass = TJvFullColorSpaceProperty;
implementation
uses
Math, SysUtils, DesignConst, TypInfo, QForms,
JvQFullColorDialogs, JvQFullColorCtrls, JvQFullColorListForm;
const
COLOR_PREVIEW_RECT = 16;
COLOR_PREVIEW_LINE = 1;
COLOR_PREVIEW_SIZE = COLOR_PREVIEW_RECT + 2 * COLOR_PREVIEW_LINE;
function HexToInt(Value: string): Byte;
begin
if Value = '' then
Result := 0
else
begin
if Length(Value) > 3 then
Value := Copy(Value, 1, 3);
Result := StrToInt(Value);
end;
end;
procedure ColorPropertyListDrawValue(AColor: TColor; AValue: string;
ACanvas: TCanvas; ARect: TRect; ASelected: Boolean);
var
OldBrushColor: TColor;
OldPenColor: TColor;
begin
with ACanvas do
begin
OldBrushColor := Brush.Color;
OldPenColor := Pen.Color;
Pen.Color := Brush.Color;
Rectangle(ARect);
Brush.Color := AColor;
Pen.Color := clBlack;
Rectangle(ARect.Left + COLOR_PREVIEW_LINE,
ARect.Top + COLOR_PREVIEW_LINE,
ARect.Left + COLOR_PREVIEW_LINE + COLOR_PREVIEW_RECT,
ARect.Top + COLOR_PREVIEW_LINE + COLOR_PREVIEW_RECT);
Pen.Color := OldPenColor;
Brush.Color := OldBrushColor;
TextOut(ARect.Left + COLOR_PREVIEW_SIZE, ARect.Top, AValue);
end;
end;
//=== { TJvFullColorProperty } ===============================================
procedure TJvFullColorProperty.DialogApply(Sender: TObject; AFullColor: TJvFullColor);
begin
SetColor(AFullColor);
end;
procedure TJvFullColorProperty.Edit;
begin
if IsColorProperty then
// a dummy param
EditSpace(csRGB)
else
EditSpace(ColorSpaceManager.GetColorSpaceID(GetOrdValue));
end;
procedure TJvFullColorProperty.EditSpace(AColorID: TJvFullColorSpaceID);
var
LColor: TJvFullColor;
begin
with ColorSpaceManager, TJvFullColorDialog.Create(nil) do
try
if IsColorProperty then
begin
LColor := ColorSpaceManager.ConvertFromColor(TColor(GetOrdValue));
// reset dummy param
AColorID := ColorSpaceManager.GetColorSpaceID(LColor);
end
else
LColor := TJvFullColor(GetOrdValue);
if GetColorSpaceID(LColor) <> AColorID then
LColor := ConvertToID(LColor, AColorID);
FullColor := LColor;
Title := '';
OnApply := DialogApply;
Options := [foFullOpen, foAllowSpaceChange, foShowNewPreview, foShowOldPreview,
foShowPredefined, foAllowVariable, foNoneAndDefault, foShowApply];
if Execute then
SetColor(FullColor);
finally
Free;
end;
end;
function TJvFullColorProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paSubProperties, paDialog, paMultiSelect,
paVolatileSubProperties, paVCL,
paRevertable];
if IsColorProperty then
Result := Result + [paReadOnly]
else
Result := Result + [paValueList, paSortList];
end;
function TJvFullColorProperty.GetIsColorProperty: Boolean;
begin
Result := (GetPropType = TypeInfo(TColor));
end;
procedure TJvFullColorProperty.GetProperties(Proc: TGetPropProc );
var
I: Integer;
CS: TJvColorSpace;
begin
with ColorSpaceManager do
for I := 0 to Count - 1 do
begin
CS := ColorSpaceByIndex[I];
Proc(FindFullColorSpaceEditor(CS.ID).Create(Self, CS, IsColorProperty));
end;
end;
function TJvFullColorProperty.GetValue: string;
var
Value: TJvFullColor;
begin
Value := GetOrdValue;
with ColorSpaceManager do
if IsColorProperty then
Result := GetPropType^.Name
else
Result := Format('%s [%s]', [GetPropType^.Name, ColorSpace[GetColorSpaceID(Value)].ShortName]);
end;
procedure TJvFullColorProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
begin
with ColorSpaceManager do
for I := 0 to Count - 1 do
Proc(ColorSpaceByIndex[I].ShortName);
end;
procedure TJvFullColorProperty.SetColor(AFullColor: TJvFullColor);
begin
with ColorSpaceManager do
if IsColorProperty then
SetOrdValue(Ord(ConvertToColor(AFullColor)))
else
SetOrdValue(Ord(AFullColor));
end;
procedure TJvFullColorProperty.SetValue(const Value: string);
var
I: Integer;
LColor: TJvFullColor;
LColorSpace: TJvColorSpace;
begin
LColor := GetOrdValue;
with ColorSpaceManager do
for I := 0 to Count - 1 do
begin
LColorSpace := ColorSpaceByIndex[I];
if LColorSpace.ShortName = Value then
begin
LColor := ColorSpaceManager.ConvertToID(LColor, LColorSpace.ID);
SetOrdValue(Ord(LColor));
Break;
end;
end;
end;
//=== { TJvFullColorSpaceProperty } ==========================================
constructor TJvFullColorSpaceProperty.Create(AParent: TJvFullColorProperty;
AColorSpace: TJvColorSpace; AIsColorProperty: Boolean);
begin
inherited Create(AParent);
FParent := AParent;
FColorSpace := AColorSpace;
end;
procedure TJvFullColorSpaceProperty.Edit;
begin
Parent.EditSpace(ColorSpace.ID);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -