iwtmscolorpicker.pas.~1~

TMS IntraWEb增强控件TMSIntraWeb_v2.3.2.1_D2007.rar

begin
  inherited;
  AdjustSize;
  DrawButton;
  if FPreviewVisible then
    DrawRect;
  if FPickerVisible then
    DrawPicker;
  Canvas.Pen.Width := 1; //Bug IW draw rect
end;

procedure TTIWColorPicker.DrawPicker;
var
 i,j,StartX,medX,medY:Integer;
 r:TRect;
begin
  StartX := FButton.Width;
  if StartX > width then
    Exit;

  medX := (Width-StartX) div FColCount;
  medY := Height div FRowCount;

  Canvas.Pen.Color := clwhite;
  Canvas.Pen.Width := 1;
  Canvas.Brush.Style := bsSolid;

  for i := 0 to FRowCount - 1 do
    for j := 0 to FColCount - 1 do
    begin
      r.Left := StartX + j * medX;
      r.Top := i * medY;
      if j = (FColCount-1) then
        r.Right := Width
      else
        r.Right := r.Left + medX;

      if i = (FRowCount-1) then
        r.Bottom := Height
      else
        r.Bottom := r.Top +  medY;

      Canvas.Brush.Color := PaletteColors[j,i];
      Canvas.Rectangle(r);
    end;

  Canvas.Pen.Color := FLineColor;
  Canvas.Pen.Width := FLineWidth;
  Canvas.Brush.Style := bsClear;
  r.Left := StartX;
  r.Top := 0;
  r.Bottom := Height;
  r.Right := width;
  Canvas.Rectangle(r);
end;

procedure TTIWColorPicker.DrawRect;
var
  r: TRect;
begin
  with FButton do
    r := Rect(0,FButton.Height,FButton.Width,FButton.Height+FRectHeight);
  Canvas.Pen.Color := FLineColor;
  Canvas.Pen.Width := FLineWidth;
  Canvas.Brush.Color:=FColor;
  Canvas.Rectangle(r);
end;

procedure TTIWColorPicker.DrawButton;
var
  r: TRect;
  x,y: Integer;
begin
  with FButton do
    r := Rect(0,0,Button.Width,Button.Height);

  {$IFNDEF LINUX}
  DrawFrameControl(Canvas.Handle,r,DFC_Button,DFCS_ButtonPUSH);
  {$ENDIF}
  if FButton.Color <> clNone then
    Canvas.Brush.Color := FButton.Color
  else
    Canvas.Brush.Color := clBtnFace;

  with Canvas do
  begin
    Font.Color := FButton.Font.Color;
    Font.Name := FButton.Font.FontName;
    Font.Size := FButton.Font.Size;
    Font.Style := FButton.Font.Style;
  end;

  InflateRect(r,-1,-1);
  with FButton do
    x := (Button.Width-Canvas.TextWidth(FCaption)) div 2;

  if x < 0 then
    x := 0;

  with FButton do
    y:=(Button.Height-Canvas.TextHeight(FCaption)) div 2;
  if y < 0 then
    y := 0;


  with FButton do
    Canvas.TextRect(r,x,y,FCaption);
end;

constructor TTIWColorPicker.Create(AOwner: TComponent);
begin
  inherited;
  FButton := TIWTMSButton.Create;
  FButton.FOnButtonChange := ButtonChange;
end;

destructor TTIWColorPicker.Destroy;
begin
  FreeAndNil(FButton);
  inherited;
end;

procedure TIWTMSButton.DoButtonChange;
begin
  if Assigned(FOnButtonChange) then
    FOnButtonChange(Self);
end;

procedure TTIWColorPicker.ButtonChange(Sender: Tobject);
begin
  Invalidate;
end;

procedure TTIWCustomColorPicker.OnFirstColorsChange(Sender: Tobject;
  index: byte;ColorChanged:Tcolor);
begin
  if FRowCount*FColCount < Index then
    Exit;
  ColorArray[index-1] := ColorChanged;
  Invalidate;
end;

function TTIWCustomColorPicker.ColorIndex(Color: TColor): Integer;
begin
  Color := ColorToRGB(Color);
  Result := 0;
  if Color = ColorToRGB(Colors.FColor1) then
    Result := 0;
  if Color = ColorToRGB(Colors.FColor2) then
    Result := 1;
  if Color = ColorToRGB(Colors.FColor3) then
    Result := 2;
  if Color = ColorToRGB(Colors.FColor4) then
    Result := 3;
  if Color = ColorToRGB(Colors.FColor5) then
    Result := 4;
  if Color = ColorToRGB(Colors.FColor6) then
    Result := 5;
  if Color = ColorToRGB(Colors.FColor7) then
    Result := 6;
  if Color = ColorToRGB(Colors.FColor8) then
    Result := 7;
  if Color = ColorToRGB(Colors.FColor9) then
    Result := 8;
  if Color = ColorToRGB(Colors.FColor10) then
    Result := 9;
  if Color = ColorToRGB(Colors.FColor11) then
    Result := 10;
  if Color = ColorToRGB(Colors.FColor12) then
    Result := 11;
  if Color = ColorToRGB(Colors.FColor13) then
    Result := 12;
  if Color = ColorToRGB(Colors.FColor14) then
    Result := 13;
  if Color = ColorToRGB(Colors.FColor15) then
    Result := 14;
  if Color = ColorToRGB(Colors.FColor16) then
    Result := 15;
end;

procedure TTIWCustomColorPicker.SetValue(const Avalue: string);
var
  v,err:integer;
begin
  inherited;

  val(AValue,v,err);

  case v of
  0: Color := Colors.FColor1;
  1: Color := Colors.FColor2;
  2: Color := Colors.FColor3;
  3: Color := Colors.FColor4;
  4: Color := Colors.FColor5;
  5: Color := Colors.FColor6;
  6: Color := Colors.FColor7;
  7: Color := Colors.FColor8;
  8: Color := Colors.FColor9;
  9: Color := Colors.FColor10;
  10: Color := Colors.FColor11;
  11: Color := Colors.FColor12;
  12: Color := Colors.FColor13;
  13: Color := Colors.FColor14;
  14: Color := Colors.FColor15;
  15: Color := Colors.FColor16;
  end;

end;

{ TIWColors }

constructor TIWColors.Create;
begin
   FColor1  := clBlack;
   FColor2  := clMaroon;
   FColor3  := clGreen;
   FColor4  := clOlive;
   FColor5  := clNavy;
   FColor6  := clPurple;
   FColor7  := clTeal;
   FColor8  := clSilver;
   FColor9  := clGray;
   FColor10 := clRed;
   FColor11 := clLime;
   FColor12 := clYellow;
   FColor13 := clBlue;
   FColor14 := clFuchsia;
   FColor15 := clAqua;
   FColor16 := clWhite;
end;

procedure TIWColors.Dochange(index: byte;ColorChanged:Tcolor);
begin
  if Assigned(FOnColorChange) then
    FOnColorChange(Self,index,ColorChanged);
end;

procedure TIWColors.Setcolor1(const Value: Tcolor);
begin
  FColor1 := Value;
  Dochange(1,Value);
end;

procedure TIWColors.Setcolor10(const Value: Tcolor);
begin
  FColor10 := Value;
  Dochange(10,Value);
end;

procedure TIWColors.Setcolor11(const Value: Tcolor);
begin
  FColor11 := Value;
  Dochange(11,Value);
end;

procedure TIWColors.Setcolor12(const Value: Tcolor);
begin
  FColor12 := Value;
  Dochange(12,Value);
end;

procedure TIWColors.Setcolor13(const Value: Tcolor);
begin
  FColor13 := Value;
  Dochange(13,Value);
end;

procedure TIWColors.Setcolor14(const Value: Tcolor);
begin
  FColor14 := Value;
  Dochange(14,Value);
end;

procedure TIWColors.Setcolor15(const Value: Tcolor);
begin
  FColor15 := Value;
  Dochange(15,Value);
end;

procedure TIWColors.Setcolor16(const Value: Tcolor);
begin
  FColor16 := Value;
  Dochange(16,Value);
end;

procedure TIWColors.Setcolor2(const Value: Tcolor);
begin
  FColor2 := Value;
  Dochange(2,Value);
end;

procedure TIWColors.Setcolor3(const Value: Tcolor);
begin
  FColor3 := Value;
  Dochange(3,Value);
end;

procedure TIWColors.Setcolor4(const Value: Tcolor);
begin
  FColor4 := Value;
  Dochange(4,Value);
end;

procedure TIWColors.Setcolor5(const Value: Tcolor);
begin
  FColor5 := Value;
  Dochange(5,Value);
end;

procedure TIWColors.Setcolor6(const Value: Tcolor);
begin
  FColor6 := Value;
  Dochange(6,Value);
end;

procedure TIWColors.Setcolor7(const Value: Tcolor);
begin
  FColor7 := Value;
  Dochange(7,Value);
end;

procedure TIWColors.Setcolor8(const Value: Tcolor);
begin
  FColor8 := Value;
  Dochange(8,Value);
end;

procedure TIWColors.Setcolor9(const Value: Tcolor);
begin
  FColor9 := Value;
  Dochange(9,Value);
end;

{$IFDEF TMSIW6}
function TTIWColorPicker.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWColorPicker.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  html,picker:string;
begin
  {$IFDEF TMSIW6}
  RenderCustomHTML(html,picker,FButton.Width,AContext);
  {$ELSE}
  RenderCustomHTML(html,picker,FButton.Width);
  {$ENDIF}

  html := '<INPUT type="button" id="Button' + HtmlName + '" value="' + FButton.caption + '" onclick="'+HTMLName+'ShowPicker()"'#13
    + 'style="'#13
    + 'height: '+IntToStr(Button.Height)+'; width:'+IntToStr(Button.Width)+#13+';'#13
    + IIF((FButton.Font.FontName <> '') and FButton.Font.Enabled,'font-family:'+FButton.Font.FontName+'; ','')+FButton.Font.CSSStyle+' font-size:'+IntToStr(FButton.Font.Size)+'; '
    + IIF((fsBold in FButton.Font.Style) and FButton.Font.Enabled,'font-weight:bold;','')
    + IIF(FButton.Font.Enabled,' color:'+HTMLClr(FButton.Font.Color)+'; cursor:hand;','')
    + IIF(FButton.Color <> clNone,' background-color:'+HTMLClr(FButton.Color)+';','')+#13
    + '">'#13

    + html
//    + '<DIV id="DIV' + HtmlName + '" style="position:relative; left:' + IntToStr(FButton.Width)+ ';top:-'+inttostr(FButton.Height+FRectHeight)+'">'
    + '<DIV id="DIV' + HtmlName + '" style="position:absolute;left:' + IntToStr(FButton.Width)+ ';top:0">'
    + picker
    +'</DIV>';

  Result := TIWHTMLTag.CreateTag('DIV');
  Result.Contents.AddText(html);
  with Result.Contents.AddTag('INPUT') do
  begin
    AddStringParam('TYPE','hidden');
    AddStringParam('NAME',HTMLName);
    AddStringParam('ID',HTMLName+'_INPUT');
  end;
end;


end.