несколько Label'ов в качестве кнопок

[skalt12]

Приветстсвую! Уважаемые форумчане, у меня новые "непонятки" с кодом.. прошу подсказки...

вот смотрите, у меня на форме, допустим, 5 TLabel'ов.. каждая - это, своего рода, кнопка.. мне нужно, чтобы при нажатии на одну, текст становился жирным, а у всех остальных нормальным.. я сделал через флажки и отдельную процедуру, но это как-то по-у*бански получается:

Procedure PressedLabels;
var label1, label2, label3, label4, label5: TLabel;
     f1, f2, f3, f4, f5: boolean;
begin
     if f1 = true then
    begin
      f2 := false; f3 := false; f4 := false; f5 := false;
      label1.Font.Style := [fsBold];
      label2.Font.Style := [];
      label3.Font.Style := [];
      label4.Font.Style := [];
      label5.Font.Style := [];
   end;
      ...
      //дальше так же еще с тремя Label'ами
      ...
     if f5 = true then
    begin
      f2 := false; f3 := false; f4 := false; f1 := false;
      label1.Font.Style := [];
      label2.Font.Style := [];
      label3.Font.Style := [];
      label4.Font.Style := [];
      label5.Font.Style := [fsBold];
    end;
end;
...
procedure TForm1.Label1Click(Sender: TObject);
begin
  f1 := true;
  PressedLabels;
end;
      ...
      //дальше так же еще с тремя Label'ами
      ...
procedure TForm1.Label5Click(Sender: TObject);
begin
  f5 := true;
  PressedLabels;
end;

Все это как-нибудь правильнее, ну или, хотя бы, покороче каким-то образом можно реализовать?

[artemavd]

procedure TForm1.Label1Click(Sender: TObject);
begin
 label1.Font.Style := [fsBold];
 label2.Font.Style := [fsNormal];
 label3.Font.Style := [fsNormal];
 label4.Font.Style := [fsNormal];
 label5.Font.Style := [fsNormal];
end;

procedure TForm1.Label2Click(Sender: TObject);
begin
 label2.Font.Style := [fsBold];
 label1.Font.Style := [fsNormal];
 label3.Font.Style := [fsNormal];
 label4.Font.Style := [fsNormal];
 label5.Font.Style := [fsNormal];
end;

procedure TForm1.Label3Click(Sender: TObject);
begin
 label3.Font.Style := [fsBold];
 label1.Font.Style := [fsNormal];
 label2.Font.Style := [fsNormal];
 label4.Font.Style := [fsNormal];
 label5.Font.Style := [fsNormal];
end;

procedure TForm1.Label4Click(Sender: TObject);
begin
 label4.Font.Style := [fsBold];
 label1.Font.Style := [fsNormal];
 label2.Font.Style := [fsNormal];
 label3.Font.Style := [fsNormal];
 label5.Font.Style := [fsNormal];
end;

procedure TForm1.Label5Click(Sender: TObject);
begin
 label5.Font.Style := [fsBold];
 label1.Font.Style := [fsNormal];
 label2.Font.Style := [fsNormal];
 label3.Font.Style := [fsNormal];
 label4.Font.Style := [fsNormal];
end;

Точно не помню на счет [fsNormal], может там ничего в скобках указывать не надо. В свойствах посмотрите.

[DIgorevich]

Можно сделать на мой взгляд немного проще... создаешь процедуру:

procedure TForm1.lab;
begin
 label1.Font.Style := [];
 label2.Font.Style := [];
 label3.Font.Style := [];
 label4.Font.Style := [];
 label5.Font.Style := [];
end;

А всем лэйблам на ОнКлик одну и туже процедуру пишешь:

procedure TForm1.label5Click(Sender: TObject);
begin
  lab;
  (sender as TLabel).Font.Style:=[fsBold];
end;

[skalt12]

Сообщение от DIgorevich

Можно сделать на мой взгляд немного проще... создаешь процедуру:

procedure TForm1.lab;
begin
 label1.Font.Style := [];
 label2.Font.Style := [];
 label3.Font.Style := [];
 label4.Font.Style := [];
 label5.Font.Style := [];
end;

А всем лэйблам на ОнКлик одну и туже процедуру пишешь:

procedure TForm1.label5Click(Sender: TObject);
begin
  lab;
  (sender as TLabel).Font.Style:=[fsBold];
end;

при щелчке на Label выпадает с сообщением, цитирую:

Debugger Exception Notification
Project project1.exe raised exceprion class EAccessViolation with message 'Access Violation at address 00455BFD in module 'project1.exe'. Read of address 880E7410'

думал, делфи глючит, перезагрузил, ан нет...

[DIgorevich]

Сообщение от skalt12

при щелчке на Label выпадает с сообщением, цитирую:


думал, делфи глючит, перезагрузил, ан нет...

А полностью Ваш код можно глянуть?
Ибо у меня работает без вопросов.

[Sanprof]

а если так?

procedure TForm1.lab(Sender: TObject);
begin
 label1.Font.Style := label1.Font.Style - [fsBold];
 label2.Font.Style := label2.Font.Style - [fsBold];
 label3.Font.Style := label3.Font.Style - [fsBold];
 label4.Font.Style := label4.Font.Style - [fsBold];
 label5.Font.Style := label5.Font.Style - [fsBold];
 (sender as TLabel).Font.Style := (sender as TLabel).Font.Style + [fsBold];
end;

а потом

procedure TForm1.label5Click(Sender: TObject);
begin
  lab(Sender);
end;

[DIgorevich]

Сообщение от Sanprof

а если так?

А так еще круче

[skalt12]

Сообщение от DIgorevich

А полностью Ваш код можно глянуть?
Ибо у меня работает без вопросов.

видемо, что-то у меня в коде не то

unit subjectTable;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, StdCtrls;

type
  TsubtableWin = class(TForm)
    DropDown: TImage;
    PopupMenu1: TPopupMenu;
    one1: TMenuItem;
    two1: TMenuItem;
    three1: TMenuItem;
    Mon: TLabel;
    Tue: TLabel;
    wed: TLabel;
    thu: TLabel;
    fri: TLabel;
    sat: TLabel;
    sun: TLabel;
    Back: TImage;
    week: TLabel;
    day: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure DropDownClick(Sender: TObject);
    procedure MonMouseEnter(Sender: TObject);
    procedure MonMouseLeave(Sender: TObject);
    procedure BackMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure weekMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TueMouseEnter(Sender: TObject);
    procedure friMouseEnter(Sender: TObject);
    procedure satMouseEnter(Sender: TObject);
    procedure sunMouseEnter(Sender: TObject);
    procedure thuMouseEnter(Sender: TObject);
    procedure wedMouseEnter(Sender: TObject);
    procedure wedMouseLeave(Sender: TObject);
    procedure TueMouseLeave(Sender: TObject);
    procedure thuMouseLeave(Sender: TObject);
    procedure sunMouseLeave(Sender: TObject);
    procedure satMouseLeave(Sender: TObject);
    procedure friMouseLeave(Sender: TObject);
    procedure MonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  subtableWin: TsubtableWin;

implementation

{$R *.dfm}
uses pngImage, IniFiles, DateUtils;

procedure PressedLabels(Sender: TObject);
var mon, tue, wed, thu, fri, sat, sun: TLabel;
begin
 mon.Font.Style := mon.Font.Style - [fsBold];
 tue.Font.Style := tue.Font.Style - [fsBold];
 wed.Font.Style := wed.Font.Style - [fsBold];
 thu.Font.Style := thu.Font.Style - [fsBold];
 fri.Font.Style := fri.Font.Style - [fsBold];
 sat.Font.Style := sat.Font.Style - [fsBold];
 sun.Font.Style := sun.Font.Style - [fsBold];
 (sender as TLabel).Font.Style := (sender as TLabel).Font.Style + [fsBold];
end;

procedure TsubtableWin.BackMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012;
begin
  ReleaseCapture;
  SubTableWin.Perform(WM_SysCommand, SC_DragMove, 0);
end;

procedure TsubtableWin.DropDownClick(Sender: TObject);
begin
  PopUpMenu1.Popup(subtableWin.Left +DropDown.Left, subtableWin.Top +DropDown.Top);
end;

procedure TsubtableWin.FormCreate(Sender: TObject);
var num, inum: string;
    settingz: TIniFIle;
begin
  settingz := TIniFile.Create(ExtractFilePath(paramStr(0)) + 'dweek.conf');
    inum := settingz.ReadString('Label', 'date', inum);
    num := IntToStr(WeeksBetween(StrToDate(inum), now +7));

  with SubtableWin do
    begin
      BorderStyle := bsNone;
      Width := 432;
      Height := 481;
      AlphaBlend := True;
      //AlphaBlendValue := 230;
      Color := TCOLOR($00E4F4F5);
    end;

  with DropDown do
    begin
      Picture.LoadFromFile(ExtractFilePath(paramStr(0)) + '/graphicZ/altWin/dropDown.png');
      Left := 260;
      Top := 15;
    end;

  with Back do
    begin
      Picture.LoadFromFile(ExtractFilePath(paramStr(0)) + '/graphicZ/altWin/subjTableBG.png');
      Left := 0;
      Top := 0;
    end;

  with week do
    begin
      Font.Name := 'Impact';
      Font.Size := 18;
      Left := 150;
      Top := 5;
      Font.Color := TCOLOR($0066A9DA);
      Caption := 'Неделя ' + num;
    end;

[skalt12]

продолжение:

  with day do
    begin
      Font.Size := 14;
      Left := 150;
      Top := 85;
      Font.Color := TCOLOR($00000);
      Caption := FormatDateTime('dddd', now) + ' (' + FormatDateTime('dd', now)
                                + ' ' + FormatDateTime('mmmm', now) + ')';
    end;

  mon.Left := 40;
  mon.Top := 60;
  mon.Caption := 'Понедельник';

  tue.Left := 110;
  tue.Top := 60;
  tue.Caption := 'Вторник';

  wed.Left := 155;
  wed.Top := 60;
  wed.Caption := 'Среда';

  thu.Left := 190;
  thu.Top := 60;
  thu.Caption := 'Четверг';

  fri.Left := 234;
  fri.Top := 60;
  fri.Caption := 'Пятница';

  sat.Left := 280;
  sat.Top := 60;
  sat.Caption := 'Суббота';

  sun.Left := 326;
  sun.Top := 60;
  sun.Caption := 'Воскресенье';

  settingZ.Free;
end;

procedure TsubtableWin.friMouseEnter(Sender: TObject);
begin
  fri.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.friMouseLeave(Sender: TObject);
begin
  fri.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.MonClick(Sender: TObject);
begin
  PressedLabels(mon);

end;

procedure TsubtableWin.MonMouseEnter(Sender: TObject);
begin
  mon.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.MonMouseLeave(Sender: TObject);
begin
  mon.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.satMouseEnter(Sender: TObject);
begin
  sat.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.satMouseLeave(Sender: TObject);
begin
  sat.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.sunMouseEnter(Sender: TObject);
begin
  sun.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.sunMouseLeave(Sender: TObject);
begin
  sun.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.thuMouseEnter(Sender: TObject);
begin
  thu.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.thuMouseLeave(Sender: TObject);
begin
  thu.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.TueMouseEnter(Sender: TObject);
begin
  tue.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.TueMouseLeave(Sender: TObject);
begin
  tue.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.wedMouseEnter(Sender: TObject);
begin
  wed.Font.Color := TCOLOR($00235CC6);
end;

procedure TsubtableWin.wedMouseLeave(Sender: TObject);
begin
  wed.Font.Color := TCOLOR($00000);
end;

procedure TsubtableWin.weekMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
const SC_DragMove = $F012;
begin
  ReleaseCapture;
  SubTableWin.Perform(WM_SysCommand, SC_DragMove, 0);
end;

end.

[DIgorevich]

Конечно не то...

procedure PressedLabels(Sender: TObject);

Надо объявить в разделе Public. Вставить там эту строку и нажать CTRL+SHIFT+C. Система сама создаст процедуру и в нее вставляешь уже этот код:

 mon.Font.Style := mon.Font.Style - [fsBold];
 tue.Font.Style := tue.Font.Style - [fsBold];
 wed.Font.Style := wed.Font.Style - [fsBold];
 thu.Font.Style := thu.Font.Style - [fsBold];
 fri.Font.Style := fri.Font.Style - [fsBold];
 sat.Font.Style := sat.Font.Style - [fsBold];
 sun.Font.Style := sun.Font.Style - [fsBold];
 (sender as TLabel).Font.Style := (sender as TLabel).Font.Style + [fsBold];

БЕЗ ВСЯКИХ var mon, tue, wed, thu, fri, sat, sun: TLabel;


И я не увидел в коде обработчика нажатий на лейблы...