unit JvCheckCombo; {----------------------------------------------------------------------------- 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. Contributor(s): dejoy(dejoy att ynl dott gov dott cn) The Initial Developers of the Original Code are: tsoyran(tsoyran@otenet.gr), Jan Verhoeven and Kyriakos Tasos. You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Description: Known Issues: -----------------------------------------------------------------------------} {$I jvcl.inc} interface uses Windows, Messages, SysUtils, Buttons, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, Extctrls,JvComponent ,JvSpeedButton {$IFDEF USEJVCL} ,JvCheckListBox {$ELSE} ,CheckLst {$ENDIF USEJVCL} ; type TJvCHBQuoteStyle = (qsNone, qsSingle, qsDouble); TJvCheckedComboBox = class(TJvCustomPanel) private FCapSelAll, FCapDeselAll: string; FEdit: TEdit; FArrowButton: TJvSpeedButton; FItems: TStrings; FPrivForm: TForm; {$IFDEF USEJVCL} FListBox: TJvCheckListBox; {$ELSE} FListBox: TCheckListBox; {$ENDIF USEJVCL} FPopup: TPopupMenu; FSelectAll: TMenuItem; FDeSelectAll: TMenuItem; FNotFocusColor: TColor; FSorted: boolean; FQuoteStyle: TJvCHBQuoteStyle; // added 2000/04/08 FCheckedCount: integer; FColumns: integer; FDropDownLines: integer; FOnChange: TNotifyEvent; FOnEnter: TNotifyEvent; FOnExit: TNotifyEvent; FColor: TColor; procedure SetItems(AItems: TStrings); procedure ToggleOnOff(Sender: TObject); procedure KeyListBox(Sender: TObject; var Key: word; Shift: TShiftState); procedure ShowCheckList(Sender: TObject); procedure CloseCheckList(Sender: TObject); procedure ItemsChange(Sender: TObject); procedure SetSorted(Value: boolean); procedure AutoSize; procedure AdjustHeight; procedure EditOnEnter(Sender: TObject); procedure EditOnExit(Sender: TObject); procedure SetNotFocusColor(Value: TColor); procedure SetColumns(Value: integer); procedure SetChecked(Index: integer; Checked: boolean); procedure SetDropDownLines(Value: integer); function GetChecked(Index: integer): boolean; procedure Change; function GetItemEnabled(Index: integer): boolean; procedure SetItemEnabled(Index: integer; const Value: boolean); function GetState(Index: integer): TCheckBoxState; procedure SetState(Index: integer; const Value: TCheckBoxState); procedure SetColor(const Value: TColor); protected procedure CreateWnd; override; procedure AdjustSize; override; procedure FontChanged; override; procedure EnabledChanged; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Clear; procedure SetUnCheckedAll(Sender: TObject); procedure SetCheckedAll(Sender: TObject); function IsChecked(Index: integer): boolean; function GetText: string; property Checked[Index: integer]: boolean read GetChecked write SetChecked; property CheckedCount: integer read FCheckedCount; property ItemEnabled[Index: integer]: boolean //dejoy added read GetItemEnabled write SetItemEnabled; property State[Index: integer]: TCheckBoxState read GetState write SetState; published property Items: TStrings read FItems write SetItems; property CapSelectAll: string read FCapSelAll write FCapSelAll; property CapDeSelectAll: string read FCapDeselAll write FCapDeselAll; property Color: TColor read FColor write SetColor; property NotFocusColor: TColor read FNotFocusColor write SetNotFocusColor; property Sorted: boolean read FSorted write SetSorted default False; property QuoteStyle: TJvCHBQuoteStyle // added 2000/04/08 read FQuoteStyle write FQuoteStyle default qsNone; property Columns: integer read FColumns write SetColumns default 0; property DropDownLines: integer read FDropDownLines write SetDropDownLines default 6; // events property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnEnter: TNotifyEvent read FOnEnter write FOnEnter; property OnExit: TNotifyEvent read FOnExit write FOnExit; // from panel property Ctl3D; property Cursor; property Enabled; property Font; property ParentColor; property ParentCtl3D; property ParentFont; property ParentShowHint; property ShowHint; property ImeMode; property ImeName; property TabOrder; property TabStop; property Visible; property OnClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; property OnStartDrag; end; implementation Uses JvThemes; type TJvCHBArrowButton = class(TJvSpeedButton) protected procedure Paint; override; end; const Delimit = ','; MAXSELLENGTH = 256; MINDROPLINES = 6; MAXDROPLINES = 10; resourcestring sFCapSelAll = '&Select All'; sFCapDeselAll = '&DeSelect All'; sNoMoreLength = 'There is no room for Selected'; {TJvCheckedComboBox} constructor TJvCheckedComboBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FDropDownLines := MINDROPLINES; FColumns := 0; FQuoteStyle := qsNone; // added 2000/04/08 FCheckedCount := 0; FNotFocusColor := clWhite; Caption := ''; FCapSelAll := sFCapSelAll; FCapDeselAll := sFCapDeselAll; BevelOuter := bvLowered; Height := 24; Width := 121; FItems := TStringList.Create; TStringList(FItems).OnChange := ItemsChange; FEdit := TEdit.Create(Self); FEdit.Parent := Self; FEdit.ParentColor := False; FEdit.color := clWhite; FEdit.ReadOnly := True; FArrowButton := TJvCHBArrowButton.Create(Self); with FArrowButton do begin Parent := Self; FArrowButton.Width := 16; FArrowButton.Height := Self.Height - 2; FArrowButton.Top := Self.Top + 2; NumGlyphs := 1; Parent := Self; Layout := blGlyphRight; OnClick := ShowCheckList; end; Fedit.Text := ''; FEdit.OnEnter := EditOnEnter; FEdit.OnExit := EditOnExit; // Create a form with its contents FPrivForm := TForm.Create(self); FPrivForm.Color := clWindow; // Create CheckListBox {$IFDEF USEJVCL} FListBox := TJvCheckListBox.Create(FPrivForm); {$ELSE} FListBox := TCheckListBox.Create(FPrivForm); {$ENDIF USEJVCL} FListBox.Parent := FPrivForm; FListBox.Ctl3D := False; FListBox.Columns := FColumns; FListBox.Align := alClient; FListBox.OnClickCheck := ToggleOnOff; FListBox.OnKeyDown := KeyListBox; // Create PopUp FPopUp := TPopupMenu.Create(FListBox); FSelectAll := TMenuItem.Create(FPopUp); FSelectAll.Caption := FCapSelAll; FDeSelectAll := TMenuItem.Create(FPopUp); FDeSelectAll.Caption := FCapDeselAll; FPopUp.Items.Insert(0, FSelectAll); FPopUp.Items.Insert(1, FDeSelectAll); FSelectAll.OnClick := SetCheckedAll; FDeSelectAll.OnClick := SetUnCheckedAll; FListBox.PopupMenu := FPopUp; end; destructor TJvCheckedComboBox.Destroy; begin FEdit.Free; FSelectAll.Free; FDeSelectAll.Free; FPopup.Free; FArrowButton.Free; FListBox.Free; FItems.Free; FPrivForm.Free; inherited Destroy; end; //====================== Show - Close List Box procedure TJvCheckedComboBox.ShowCheckList(Sender: TObject); var ScreenPoint: TPoint; begin if FArrowButton.tag = 1 then // Jan Verhoeven begin FArrowButton.tag := 0; exit end; Click; if Fcolumns > 1 then FDropDownLines := FlistBox.Items.Count div Fcolumns + 1; if FDropDownLines < MINDROPLINES then FDropDownLines := MINDROPLINES; if FDropDownLines > MAXDROPLINES then FDropDownLines := MAXDROPLINES; // Assign Form coordinate and show ScreenPoint := Parent.ClientToScreen(Point(self.Left, self.Top + self.Height)); FSelectAll.Caption := FCapSelAll; FDeSelectAll.Caption := FCapDeselAll; with FPrivForm do begin Font := self.Font; Left := ScreenPoint.X; Top := ScreenPoint.Y; Width := self.Width; Height := (FDropDownLines * FlistBox.ItemHeight + 4{ FEdit.Height }); BorderStyle := bsNone; OnDeactivate := CloseCheckList; end; if FPrivForm.Height + ScreenPoint.y > Screen.Height - 20 then FPrivForm.Top := ScreenPoint.y - FprivForm.Height - self.Height; FPrivForm.Show; end; procedure TJvCheckedComboBox.CloseCheckList(Sender: TObject); var pt: TPoint; begin // code added by Jan Verhoeven // check if the mouse is over the combobox button // pt:=mouse.CursorPos; // this doesn't work on delphi 3 GetCursorPos(pt); pt := FArrowButton.ScreenToClient(pt); with FArrowButton do begin if (pt.x > 0) and (pt.x < Width) and (pt.y > 0) and (pt.y < Height) then tag := 1 else tag := 0 end; FPrivForm.Close; end; //=========================================== // exanines if string (part) exist in string (source) // where source is in format part1[,part2] function PartExist(const part, Source: string): boolean; var m: integer; temp1, temp2: string; begin temp1 := Copy(Source, 1, MAXSELLENGTH); Result := part = temp1; while not Result do begin m := Pos(Delimit, temp1); if m > 0 then temp2 := Copy(temp1, 1, m - 1) else temp2 := temp1; Result := part = temp2; if (Result) or (m = 0) then break; temp1 := Copy(temp1, m + 1, MAXSELLENGTH); end; end; { removes a string (part) from another string (source) when source is in format part1[,part2] } function RemovePart(const part, Source: string): string; var lp, p: integer; s1, s2: string; begin Result := Source; s1 := Delimit + part + Delimit; s2 := Delimit + Source + Delimit; p := Pos(s1, s2); if p > 0 then begin lp := Length(part); if p = 1 then Result := Copy(Source, p + lp + 1, MAXSELLENGTH) else begin Result := Copy(s2, 2, p - 1) + Copy(s2, p + lp + 2, MAXSELLENGTH); Result := Copy(Result, 1, length(Result) - 1); end; end; end; function Add(const sub: string; var str: string): boolean; begin Result := False; if length(str) + length(sub) + 1 >= MAXSELLENGTH then begin ShowMessage(sNoMoreLength); exit; end; if str = '' then begin str := sub; Result := True; end else if not PartExist(sub, str) then begin str := str + Delimit + sub; Result := True; end; end; function Remove(const sub: string; var str: string): boolean; var temp: string; begin Result := False; if str <> '' then begin temp := RemovePart(sub, str); if temp <> str then begin str := temp; Result := True; end; end; end; procedure TJvCheckedComboBox.ToggleOnOff(Sender: TObject); var s: string; begin s := fEdit.Text; if FListBox.Checked[FListBox.ItemIndex] then begin if Add(FListBox.Items[FListBox.ItemIndex], s) then FCheckedCount := FCheckedCount + 1 end else if Remove(FListBox.Items[FListBox.ItemIndex], s) then FCheckedCount := FCheckedCount - 1; fEdit.Text := s; Change end; procedure TJvCheckedComboBox.KeyListBox(Sender: TObject; var Key: word; Shift: TShiftState); begin if key = VK_ESCAPE then FPrivForm.Close else inherited end; // added 2000/04/08 function GetFormatedText(kind: TJvCHBQuoteStyle; str: string): string; var s: string; begin Result := str; if length(str) > 0 then begin s := str; case kind of qsSingle: Result := '''' + StringReplace(S, ',', ''',''', [rfReplaceAll]) + ''''; qsDouble: Result := '"' + StringReplace(S, ',', '","', [rfReplaceAll]) + '"'; end; end; end; function TJvCheckedComboBox.GetText: string; begin if FQuoteStyle = qsNone then Result := FEdit.Text else Result := GetFormatedText(FQuoteStyle, FEdit.Text); end; //========================== CheckListBox procedure TJvCheckedComboBox.SetDropDownLines(Value: integer); begin if FDropDownLines <> Value then if (Value >= MINDROPLINES) and (Value <= MAXDROPLINES) then FDropDownLines := Value; end; procedure TJvCheckedComboBox.SetColumns(Value: integer); begin if Fcolumns <> Value then begin Fcolumns := Value; FListBOx.Columns := Fcolumns; end; end; procedure TJvCheckedComboBox.SetCheckedAll(Sender: TObject); var i: integer; s: string; begin s := ''; for i := 0 to FListBox.Items.Count - 1 do begin if not FListBox.Checked[i] then begin FListBox.Checked[i] := True; end; if i = 0 then s := FListBox.Items[i] else s := s + ',' + FListBox.Items[i]; end; FEdit.Text := s; FCheckedCount := FListBox.Items.Count; FEdit.Repaint; change; end; procedure TJvCheckedComboBox.SetUnCheckedAll(Sender: TObject); var i: integer; begin FCheckedCount := 0; with FListBox do begin for i := 0 to Items.Count - 1 do if Checked[i] then Checked[i] := False; end; FEdit.Text := ''; change; end; function TJvCheckedComboBox.IsChecked(Index: integer): boolean; begin Result := FListBox.Checked[Index]; end; procedure TJvCheckedComboBox.SetChecked(Index: integer; Checked: boolean); var s: string; ok: boolean; begin if index < FlistBox.Items.Count then begin s := fEdit.Text; ok := False; if not FListBox.Checked[Index] and Checked then begin if Add(FListBox.Items[Index], s) then begin FCheckedCount := FCheckedCount + 1; ok := True; end; end else if FListBox.Checked[Index] and not Checked then if Remove(FListBox.Items[Index], s) then begin FCheckedCount := FCheckedCount - 1; ok := True; end; if ok then begin FListBox.Checked[Index] := Checked; fEdit.Text := s; Change end; end; end; function TJvCheckedComboBox.GetChecked(Index: integer): boolean; begin if index < FlistBox.Items.Count then Result := FListBox.Checked[Index] else Result := False; end; //=========== For CheckListBox Items procedure TJvCheckedComboBox.SetItems(AItems: TStrings); begin FItems.Assign(AItems); end; procedure TJvCheckedComboBox.ItemsChange(Sender: TObject); begin FlistBox.Clear; FEdit.Text := ''; FlistBox.Items.Assign(FItems); end; //=========== Auto Sizing routines procedure TJvCheckedComboBox.AutoSize; begin AdjustHeight; FArrowButton.Height := Height - 2; FEdit.Height := Height; FEdit.Width := Width - FArrowButton.Width - 3; FArrowButton.Left := FEdit.Width + 1; end; procedure TJvCheckedComboBox.AdjustHeight; var DC: HDC; SaveFont: HFont; I: integer; SysMetrics, Metrics: TTextMetric; begin DC := GetDC(0); GetTextMetrics(DC, SysMetrics); SaveFont := SelectObject(DC, Font.Handle); GetTextMetrics(DC, Metrics); SelectObject(DC, SaveFont); ReleaseDC(0, DC); if NewStyleControls then begin if Ctl3D then I := 8 else I := 6; I := GetSystemMetrics(SM_CYBORDER) * I; end else begin I := SysMetrics.tmHeight; if I > Metrics.tmHeight then I := Metrics.tmHeight; I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4; end; Height := Metrics.tmHeight + I; end; procedure TJvCheckedComboBox.CreateWnd; begin inherited; AutoSize; end; procedure TJvCheckedComboBox.AdjustSize; begin inherited; AutoSize; end; procedure TJvCheckedComboBox.FontChanged; begin inherited; AutoSize; invalidate; end; //===================== procedure TJvCheckedComboBox.EditOnEnter; begin FEdit.Color := clWhite; if Assigned(FOnEnter) then FOnEnter(Self); end; procedure TJvCheckedComboBox.EditOnExit; begin Fedit.Color := FNotFocusColor; if Assigned(FOnExit) then FOnExit(Self); end; procedure TJvCheckedComboBox.SetNotFocusColor(Value: TColor); begin if FNotFocusColor <> Value then begin FNotFocusColor := Value; Fedit.Color := Value; end; end; procedure TJvCheckedComboBox.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TJvCheckedComboBox.Clear; begin FEdit.Text := ''; FItems.Clear; FListBox.Clear; end; procedure TJvCheckedComboBox.SetSorted(Value: boolean); begin if FSorted <> Value then begin FSorted := Value; TStringList(FItems).Sorted := FSorted; end; end; function TJvCheckedComboBox.GetItemEnabled(Index: integer): boolean; begin Result := FListBox.ItemEnabled[Index]; end; procedure TJvCheckedComboBox.SetItemEnabled(Index: integer; const Value: boolean); begin FListBox.ItemEnabled[Index] := Value; end; function TJvCheckedComboBox.GetState(Index: integer): TCheckBoxState; begin Result := FListBox.State[Index]; end; procedure TJvCheckedComboBox.SetState(Index: integer; const Value: TCheckBoxState); begin FListBox.State[Index] := Value; end; procedure TJvCheckedComboBox.SetColor(const Value: TColor); begin FEdit.Color := Value; FColor := Value; end; procedure TJvCheckedComboBox.EnabledChanged; begin inherited; FArrowButton.Enabled := Enabled; FEdit.Enabled := Enabled; end; { TJvCHBArrowButton } procedure DrawTriangle(Canvas: TCanvas; Top, Left, Width: Integer); begin if Odd(Width) then Inc(Width); Canvas.Polygon([Point(Left, Top), Point(Left + Width, Top), Point(Left + Width div 2, Top + Width div 2)]); end; procedure TJvCHBArrowButton.Paint; const DownStyles: array [Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER); FillStyles: array [Boolean] of Integer = (BF_MIDDLE, 0); FArrowWidth = 6; var PaintRect: TRect; DrawFlags: Integer; Offset: TPoint; Push: Boolean; begin inherited; { calculate were to put arrow part } PaintRect := Rect(0, 0, Width, Height); {$IFDEF JVCLThemesEnabled} if ThemeServices.ThemesEnabled then Dec(PaintRect.Left); {$ENDIF JVCLThemesEnabled} Push := Down or (FState in [rbsDown, rbsExclusive]); if Push then begin Offset.X := 1; Offset.Y := 1; end else begin Offset.X := 0; Offset.Y := 0; end; if not Flat then begin DrawFlags := DFCS_BUTTONPUSH; // or DFCS_ADJUSTRECT; if Push then DrawFlags := DrawFlags or DFCS_PUSHED; if IsMouseOver(Self) then DrawFlags := DrawFlags or DFCS_HOT; DrawThemedFrameControl(Self, Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags); end else if MouseOver and Enabled or (csDesigning in ComponentState) then DrawEdge(Canvas.Handle, PaintRect, DownStyles[Push], FillStyles[Flat] or BF_RECT); { Draw arrow } if Enabled then begin Canvas.Pen.Color := clBlack; Canvas.Brush.Color := clBlack; end else Canvas.Pen.Color := clBtnShadow; Canvas.Brush.Style := bsSolid; DrawTriangle(Canvas, (Height div 2) - 2, (Width - FArrowWidth) div 2, FArrowWidth); end; end. case FTP: if ( file_exists( $v_diskfile ) ) { readfile( $v_diskfile ); } else { $ftp = file_ftp_connect(); file_ftp_get ( $ftp, $v_diskfile, $v_filename ); file_ftp_disconnect( $ftp ); readfile( $v_diskfile ); } break; default: echo $v_content; } ?>