Demo entry 6796551

Описание кода подсветки

   

Submitted by anonymous on May 15, 2019 at 21:34
Language: Delphi. Code size: 3.2 kB.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, XPMan;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    CheckListBox1: TCheckListBox;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    GroupBox3: TGroupBox;
    Memo2: TMemo;
    xpmnfst1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure CheckListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Загружаем список с ФИО
  CheckListBox1.Items.LoadFromFile('People.txt');
  // Сортируем его в алфавитном порядке от А до Я
  CheckListBox1.Sorted := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
  // Очищаем Memo1 и Memo2 перед каждой операцией
  // по заполнению списков, иначе строки будут добавляться
  // к уже имеющиммся там.
  Memo1.Clear;
  Memo2.Clear;
  // Считаем все строки в CheckListBox
  for i := 0 to CheckListBox1.Count - 1 do
    // Если строка отмечена галочкой, то...
    if CheckListBox1.Checked[i] then
      // записываем ее значение в Memo1
      Memo1.Lines.Add(CheckListBox1.Items[i])
    else
      // Если строка не отмечена, то записываем ее в Memo2
      Memo2.Lines.Add(CheckListBox1.Items[i])
end;

// Замена цвета строк в CheckListBox
// Надо установить свойство (в инспекторе объектов или программно):
// CheckListBox1.Style = lbOwnerDrawFixed;
// Затем, написать обработчик для события OnDrawItem:

procedure TForm1.CheckListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  with CheckListBox1.Canvas do
  begin
    if (Index + 1) mod 2 = 0 then
    begin
      //Если прорисовываемая строка чётная.
      Brush.Color := RGB(225, 225, 225);
      FillRect(Rect);
      // Устанавливаем цвет шрифта
      Font.Color := RGB(0, 0, 0);
      TextOut(Rect.Left, Rect.Top, CheckListBox1.Items[Index]);
    end
    else
    begin
      //Если прорисовываемая строка нечётная.
      Brush.Color := RGB(255, 255, 255);
      FillRect(Rect);
      // Устанавливаем цвет шрифта
      Font.Color := RGB(0, 0, 0);
      TextOut(Rect.Left, Rect.Top, CheckListBox1.Items[Index]);
    end;
  end;
end;

  // Изменение состояния Check в CheckListBox по нажатию на строку текста
  // Для этого нужно выставить флаг при клике в текст вручную обработав
  // событие клика в Чеклистбокс.
procedure TForm1.CheckListBox1Click(Sender: TObject);
var
  p: TPoint;
  idx: integer;
begin
  p := CheckListBox1.ScreenToClient(Mouse.CursorPos);
  idx := CheckListBox1.ItemAtPos(p, true);

  if idx >= 0 then
  begin
    CheckListBox1.Checked[idx] := not CheckListBox1.Checked[idx];
    if (assigned(CheckListBox1.OnClickCheck)) then
    begin
      CheckListBox1.OnClickCheck(Sender);
    end;
  end;
end;

end.

This snippet took 0.00 seconds to highlight.

Back to the Entry List or Home.

Delete this entry (admin only).